2023-09-14 19:43:13 +03:00
|
|
|
|
|
|
|
|
%{
|
|
|
|
|
#include <string.h>
|
|
|
|
|
#include "inc.h"
|
|
|
|
|
#include "extern.h"
|
|
|
|
|
#include "defines.h"
|
|
|
|
|
#include "fdvm.h"
|
|
|
|
|
#include "fm.h"
|
|
|
|
|
|
|
|
|
|
/* We may use builtin alloca */
|
|
|
|
|
#include "compatible.h"
|
|
|
|
|
#ifdef _NEEDALLOCAH_
|
|
|
|
|
# include <alloca.h>
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
#define EXTEND_NODE 2 /* move the definition to h/ files. */
|
|
|
|
|
|
|
|
|
|
extern PTR_BFND global_bfnd, pred_bfnd;
|
|
|
|
|
extern PTR_SYMB star_symb;
|
|
|
|
|
extern PTR_SYMB global_list;
|
|
|
|
|
extern PTR_TYPE global_bool;
|
|
|
|
|
extern PTR_TYPE global_int;
|
|
|
|
|
extern PTR_TYPE global_float;
|
|
|
|
|
extern PTR_TYPE global_double;
|
|
|
|
|
extern PTR_TYPE global_char;
|
|
|
|
|
extern PTR_TYPE global_string;
|
|
|
|
|
extern PTR_TYPE global_string_2;
|
|
|
|
|
extern PTR_TYPE global_complex;
|
|
|
|
|
extern PTR_TYPE global_dcomplex;
|
|
|
|
|
extern PTR_TYPE global_gate;
|
|
|
|
|
extern PTR_TYPE global_event;
|
|
|
|
|
extern PTR_TYPE global_sequence;
|
|
|
|
|
extern PTR_TYPE global_default;
|
|
|
|
|
extern PTR_LABEL thislabel;
|
|
|
|
|
extern PTR_CMNT comments, cur_comment;
|
|
|
|
|
extern PTR_BFND last_bfnd;
|
|
|
|
|
extern PTR_TYPE impltype[];
|
|
|
|
|
extern int nioctl;
|
|
|
|
|
extern int maxdim;
|
|
|
|
|
extern long yystno; /* statement label */
|
|
|
|
|
extern char stmtbuf[]; /* input buffer */
|
|
|
|
|
extern char *commentbuf; /* comments buffer from scanner */
|
|
|
|
|
extern PTR_BLOB head_blob;
|
|
|
|
|
extern PTR_BLOB cur_blob;
|
|
|
|
|
extern PTR_TYPE vartype; /* variable type */
|
|
|
|
|
extern int end_group;
|
|
|
|
|
extern char saveall;
|
|
|
|
|
extern int privateall;
|
|
|
|
|
extern int needkwd;
|
|
|
|
|
extern int implkwd;
|
|
|
|
|
extern int opt_kwd_hedr;
|
|
|
|
|
/* added for FORTRAN 90 */
|
|
|
|
|
extern PTR_LLND first_unresolved_call;
|
|
|
|
|
extern PTR_LLND last_unresolved_call;
|
|
|
|
|
extern int data_stat;
|
|
|
|
|
extern char yyquote;
|
|
|
|
|
|
|
|
|
|
extern int warn_all;
|
|
|
|
|
extern int statement_kind; /* kind of statement: 1 - HPF-DVM-directive, 0 - Fortran statement*/
|
|
|
|
|
int extend_flag = 0;
|
|
|
|
|
|
|
|
|
|
static int do_name_err;
|
|
|
|
|
static int ndim; /* number of dimension */
|
|
|
|
|
/*!!! hpf */
|
|
|
|
|
static int explicit_shape; /* 1 if shape specification is explicit */
|
|
|
|
|
/* static int varleng;*/ /* variable size */
|
|
|
|
|
static int lastwasbranch = NO; /* set if last stmt was a branch stmt */
|
|
|
|
|
static int thiswasbranch = NO; /* set if this stmt is a branch stmt */
|
|
|
|
|
static PTR_SYMB type_var = SMNULL;
|
|
|
|
|
static PTR_LLND stat_alloc = LLNULL; /* set if ALLOCATE/DEALLOCATE stmt has STAT-clause*/
|
|
|
|
|
/* static int subscripts_status = 0; */
|
|
|
|
|
static int type_options,type_opt; /* The various options used to declare a name -
|
|
|
|
|
RECURSIVE, POINTER, OPTIONAL etc. */
|
|
|
|
|
static PTR_BFND module_scope;
|
|
|
|
|
static int position = IN_OUTSIDE;
|
|
|
|
|
static int attr_ndim; /* number of dimensions in DIMENSION (array_spec)
|
|
|
|
|
attribute declaration */
|
|
|
|
|
static PTR_LLND attr_dims; /* low level representation of array_spec in
|
|
|
|
|
DIMENSION (array_spec) attribute declarartion. */
|
|
|
|
|
static int in_vec = NO; /* set if processing array constructor */
|
|
|
|
|
%}
|
|
|
|
|
|
|
|
|
|
%union {
|
|
|
|
|
int token;
|
|
|
|
|
char charv;
|
|
|
|
|
char *charp;
|
|
|
|
|
PTR_BFND bf_node;
|
|
|
|
|
PTR_LLND ll_node;
|
|
|
|
|
PTR_SYMB symbol;
|
|
|
|
|
PTR_TYPE data_type;
|
|
|
|
|
PTR_HASH hash_entry;
|
|
|
|
|
PTR_LABEL label;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* gram.head
|
|
|
|
|
*
|
|
|
|
|
* First part of the Fortran grammar
|
|
|
|
|
*
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
/* Specify precedences and associativities. */
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
%left COMMA
|
|
|
|
|
%nonassoc COLON
|
|
|
|
|
%right EQUAL
|
|
|
|
|
%left DEFINED_OPERATOR
|
|
|
|
|
%left BINARY_OP
|
|
|
|
|
%left EQV NEQV
|
|
|
|
|
%left OR XOR
|
|
|
|
|
%left AND
|
|
|
|
|
%left NOT
|
|
|
|
|
%nonassoc LT GT LE GE EQ NE
|
|
|
|
|
%left DSLASH
|
|
|
|
|
%left PLUS MINUS
|
|
|
|
|
%left ASTER SLASH
|
|
|
|
|
%right DASTER
|
|
|
|
|
%nonassoc UNARY_OP
|
|
|
|
|
|
|
|
|
|
%start program
|
|
|
|
|
%type <token> addop stop att_type
|
|
|
|
|
%type <charv> letter
|
|
|
|
|
%type <charp> filename
|
|
|
|
|
%type <hash_entry> name opt_unit_name
|
|
|
|
|
%type <symbol> progname blokname args arg arglist call comblock namelist_group
|
|
|
|
|
%type <bf_node> program stat spec exec iffable goto logif
|
|
|
|
|
%type <bf_node> dcl implicit data common dimension external intrinsic attrib
|
|
|
|
|
%type <bf_node> equivalence namelist type_dcl end_type static
|
|
|
|
|
%type <bf_node> intent optional public private sequence allocatable pointer target
|
|
|
|
|
%type <ll_node> implist impitem
|
|
|
|
|
%type <ll_node> paramlist paramitem
|
|
|
|
|
%type <ll_node> dim dims dimlist ubound funarglist funarg funargs opt_expr var
|
|
|
|
|
%type <ll_node> labellist expr uexpr lhs simple_const lengspec substring
|
|
|
|
|
%type <ll_node> complex_const vec triplet
|
|
|
|
|
%type <ll_node> dospec use_name_list
|
|
|
|
|
%type <symbol> do_var
|
|
|
|
|
%type <label> dotarget
|
|
|
|
|
%type <symbol> funcname typedfunc procname
|
|
|
|
|
%type <ll_node> equivset equivlist
|
|
|
|
|
%type <ll_node> savelist saveitem
|
|
|
|
|
|
|
|
|
|
/* FORTRAN 90 */
|
|
|
|
|
%type <hash_entry> defined_op intrinsic_op operator construct_name
|
|
|
|
|
%type <bf_node> case whereable interface use_stat forall
|
|
|
|
|
%type <ll_node> forall_list forall_expr opt_forall_cond
|
|
|
|
|
%type <bf_node> module_proc_stmt do_while plain_do
|
|
|
|
|
%type <ll_node> opt_result_clause case_selector case_value_range
|
|
|
|
|
%type <ll_node> case_value_range_list proper_lengspec
|
|
|
|
|
%type <symbol> opt_construct_name
|
|
|
|
|
%type <symbol> module_name
|
|
|
|
|
%type <ll_node> selector initial_value clause opt_while
|
|
|
|
|
%type <ll_node> options attr_spec_list attr_spec intent_spec access_spec
|
|
|
|
|
%type <ll_node> string_constant structure_component opt_substring
|
|
|
|
|
%type <ll_node> array_ele_substring_func_ref ident array_element
|
|
|
|
|
%type <ll_node> subscript_list asubstring equi_object
|
|
|
|
|
%type <ll_node> allocation_list allocate_object_list
|
|
|
|
|
%type <ll_node> allocate_object pointer_name_list rename_list rename_name use_name
|
|
|
|
|
%type <ll_node> only_list only_name proc_name_list construct_name_colon
|
|
|
|
|
%type <ll_node> kind numeric_bool_const integer_constant proc_attr
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* used by I/O statement
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
%type <bf_node> io read write print iofmove iofctl fmkwd ctlkwd inquire
|
|
|
|
|
%type <ll_node> fexpr unpar_fexpr
|
|
|
|
|
%type <ll_node> ioctl ctllist ioclause nameeq inlist inelt
|
|
|
|
|
%type <ll_node> outlist out2 other infmt
|
|
|
|
|
|
|
|
|
|
%type <ll_node> label letgroups letgroup let
|
|
|
|
|
%type <ll_node> callarglist callarg
|
|
|
|
|
%type <data_type> typename typespec type type_implicit
|
|
|
|
|
%type <label> thislabel
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
%type <ll_node> dataimplieddo dlist dataelt datasubs datarange
|
|
|
|
|
%type <ll_node> iconexprlist opticonexpr iconexpr iconterm
|
|
|
|
|
%type <ll_node> iconfactor iconprimary
|
|
|
|
|
%type <symbol> dataname d_name
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
*
|
|
|
|
|
* used by HPF and FDVM
|
|
|
|
|
*/
|
|
|
|
|
%type <bf_node> dvm_specification dvm_combined_dir dvm_pointer dvm_heap
|
|
|
|
|
%type <bf_node> dvm_template dvm_processors dvm_indirect_group dvm_remote_group
|
|
|
|
|
%type <bf_node> dvm_task dvm_inherit dvm_new_value
|
|
|
|
|
%type <bf_node> dvm_dynamic dvm_align dvm_realign align_directive_stuff
|
|
|
|
|
%type <bf_node> dvm_distribute dvm_redistribute dvm_exec
|
|
|
|
|
%type <bf_node> dvm_parallel_on dvm_remote_access
|
|
|
|
|
%type <bf_node> dvm_shadow_group dvm_shadow_start dvm_shadow_wait dvm_shadow
|
|
|
|
|
%type <bf_node> dvm_reduction_group dvm_reduction_start dvm_reduction_wait
|
|
|
|
|
%type <bf_node> dvm_task_region dvm_end_task_region dvm_map dvm_on dvm_end_on
|
|
|
|
|
%type <bf_node> dvm_reset dvm_prefetch dvm_indirect_access hpf_independent
|
|
|
|
|
%type <bf_node> dvm_debug_dir dvm_enddebug_dir dvm_traceon_dir dvm_traceoff_dir
|
|
|
|
|
%type <bf_node> dvm_interval_dir dvm_endinterval_dir dvm_exit_interval_dir dvm_barrier_dir dvm_check
|
|
|
|
|
%type <bf_node> dvm_io_mode_dir dvm_shadow_add dvm_localize
|
|
|
|
|
%type <bf_node> dvm_cp_create dvm_cp_load dvm_cp_save dvm_cp_wait dvm_template_create dvm_template_delete
|
|
|
|
|
%type <bf_node> dvm_asyncid dvm_f90 dvm_asynchronous dvm_endasynchronous dvm_asyncwait
|
|
|
|
|
%type <bf_node> dvm_consistent_group dvm_consistent_start dvm_consistent_wait dvm_consistent
|
|
|
|
|
%type <ll_node> dist_name dist_name_list dist_format dist_format_list
|
|
|
|
|
%type <ll_node> distributee pointer_ar_elem
|
|
|
|
|
%type <ll_node> dist_format_clause opt_dist_format_clause shadow_width
|
|
|
|
|
%type <ll_node> opt_spec dvm_attribute_list dvm_attribute
|
|
|
|
|
%type <ll_node> new_spec reduction_spec shadow_spec remote_access_spec
|
|
|
|
|
%type <ll_node> spec_list par_spec indirect_access_spec across_spec stage_spec
|
|
|
|
|
%type <ll_node> in_out_across opt_in_out
|
|
|
|
|
%type <ll_node> dependent_array_list dependent_array dependence dependence_list
|
|
|
|
|
%type <ll_node> variable_list reduction_list shadow_list distribute_cycles
|
|
|
|
|
%type <ll_node> reduction reduction_op loc_op array_ident array_ident_list shadow
|
|
|
|
|
%type <ll_node> dyn_array_name_list dyn_array_name
|
|
|
|
|
%type <ll_node> heap_array_name_list heap_array_name
|
|
|
|
|
%type <ll_node> align_base align_subscript_list par_subscript_list par_subscript
|
|
|
|
|
%type <ll_node> remote_data_list remote_data remote_index_list remote_index
|
|
|
|
|
%type <ll_node> dim_ident_list dim_ident align_subscript
|
|
|
|
|
%type <ll_node> realignee_list alignee realignee
|
|
|
|
|
%type <ll_node> dummy_array_name_list dummy_array_name
|
|
|
|
|
%type <ll_node> ident_list sh_array_name
|
|
|
|
|
%type <ll_node> shadow_attr_stuff sh_width sh_width_list
|
|
|
|
|
%type <ll_node> pointer_var pointer_var_list dimension_list
|
|
|
|
|
%type <ll_node> interval_number fragment_number
|
|
|
|
|
%type <ll_node> task task_array opt_private_spec async
|
|
|
|
|
%type <ll_node> indirect_list indirect_reference opt_onto opt_on hpf_reduction_spec
|
|
|
|
|
%type <ll_node> debparamlist debparam async_id_list async_id high_section
|
|
|
|
|
%type <ll_node> section_spec_list section_spec section ar_section low_section
|
|
|
|
|
%type <ll_node> consistent_spec consistent_array_name_list consistent_array_name
|
|
|
|
|
%type <ll_node> mode_list mode_spec opt_mode
|
|
|
|
|
%type <ll_node> derived_spec derived_elem derived_elem_list target_spec
|
|
|
|
|
%type <ll_node> derived_subscript derived_subscript_list opt_plus_shadow plus_shadow shadow_id
|
|
|
|
|
%type <ll_node> template_ref template_obj shadow_axis shadow_axis_list opt_include_to
|
|
|
|
|
%type <ll_node> localize_target target_subscript target_subscript_list aster_expr dummy_ident
|
|
|
|
|
%type <ll_node> template_list tie_spec tied_array_list
|
|
|
|
|
%type <symbol> processors_name align_base_name
|
|
|
|
|
%type <symbol> shadow_group_name reduction_group_name reduction_group indirect_group_name task_name
|
|
|
|
|
%type <symbol> remote_group_name group_name array_name async_ident consistent_group_name consistent_group
|
|
|
|
|
%type <symbol> derived_target
|
|
|
|
|
|
|
|
|
|
/* FORTRAN OPENMPDVM*/
|
|
|
|
|
%type <bf_node> omp_specification_directive omp_threadprivate_directive
|
|
|
|
|
%type <bf_node> omp_execution_directive omp_section_directive
|
|
|
|
|
%type <bf_node> omp_parallel_begin_directive omp_parallel_end_directive
|
|
|
|
|
%type <bf_node> omp_sections_begin_directive omp_sections_end_directive
|
|
|
|
|
%type <bf_node> omp_do_begin_directive omp_do_end_directive
|
|
|
|
|
%type <bf_node> omp_single_begin_directive omp_single_end_directive
|
|
|
|
|
%type <bf_node> omp_workshare_begin_directive omp_workshare_end_directive
|
|
|
|
|
%type <bf_node> omp_parallel_do_begin_directive omp_parallel_do_end_directive
|
|
|
|
|
%type <bf_node> omp_parallel_sections_begin_directive omp_parallel_sections_end_directive
|
|
|
|
|
%type <bf_node> omp_parallel_workshare_begin_directive omp_parallel_workshare_end_directive
|
|
|
|
|
%type <bf_node> omp_master_begin_directive omp_master_end_directive
|
|
|
|
|
%type <bf_node> omp_ordered_begin_directive omp_ordered_end_directive
|
|
|
|
|
%type <bf_node> omp_barrier_directive omp_atomic_directive omp_flush_directive
|
|
|
|
|
%type <bf_node> omp_critical_begin_directive omp_critical_end_directive ompdvm_onethread
|
|
|
|
|
|
|
|
|
|
%type <ll_node> parallel_clause_list parallel_clause
|
|
|
|
|
%type <ll_node> ompprivate_clause ompfirstprivate_clause
|
|
|
|
|
%type <ll_node> omplastprivate_clause ompcopyin_clause
|
|
|
|
|
%type <ll_node> ompshared_clause ompdefault_clause
|
|
|
|
|
%type <ll_node> def_expr ompif_clause ompnumthreads_clause
|
|
|
|
|
%type <ll_node> ompreduction_clause ompreduction ompreduction_vars
|
|
|
|
|
%type <ll_node> ompreduction_op
|
|
|
|
|
%type <ll_node> sections_clause_list sections_clause
|
|
|
|
|
%type <ll_node> do_clause_list do_clause omp_variable_list
|
|
|
|
|
%type <ll_node> omp_common_var omp_variable_list_in_par
|
|
|
|
|
%type <ll_node> ompordered_clause ompschedule_clause ompschedule_op
|
|
|
|
|
%type <ll_node> single_clause_list single_clause
|
|
|
|
|
%type <ll_node> end_single_clause_list end_single_clause
|
|
|
|
|
%type <ll_node> ompcopyprivate_clause ompnowait_clause
|
|
|
|
|
%type <ll_node> paralleldo_clause_list paralleldo_clause
|
|
|
|
|
|
|
|
|
|
/* FORTRAN ACC */
|
|
|
|
|
%type <bf_node> acc_directive acc_region acc_end_region acc_checksection acc_end_checksection
|
|
|
|
|
%type <bf_node> acc_get_actual acc_actual acc_routine
|
|
|
|
|
%type <ll_node> opt_clause acc_clause_list acc_clause data_clause async_clause targets_clause
|
|
|
|
|
%type <ll_node> acc_var_list computer_list computer opt_targets_clause
|
|
|
|
|
|
|
|
|
|
/* new clauses for PARALLEL directive */
|
|
|
|
|
%type <ll_node> private_spec cuda_block_spec sizelist
|
|
|
|
|
|
|
|
|
|
/* SAPFOR */
|
|
|
|
|
%type <bf_node> spf_directive spf_analysis spf_parallel spf_transform spf_parallel_reg spf_end_parallel_reg
|
|
|
|
|
%type <bf_node> spf_checkpoint
|
|
|
|
|
%type <ll_node> analysis_spec_list analysis_spec analysis_reduction_spec analysis_private_spec analysis_parameter_spec
|
|
|
|
|
%type <ll_node> parallel_spec_list parallel_spec parallel_shadow_spec parallel_across_spec parallel_remote_access_spec
|
|
|
|
|
%type <ll_node> transform_spec_list transform_spec array_element_list spf_parameter_list spf_parameter
|
|
|
|
|
%type <ll_node> characteristic characteristic_list opt_clause_apply_region opt_clause_apply_fragment
|
|
|
|
|
%type <ll_node> checkpoint_spec checkpoint_spec_list spf_type_list spf_type interval_spec unroll_list
|
|
|
|
|
%type <symbol> region_name
|
|
|
|
|
|
|
|
|
|
%{
|
|
|
|
|
void add_scope_level();
|
|
|
|
|
void delete_beyond_scope_level();
|
|
|
|
|
PTR_HASH look_up_sym();
|
|
|
|
|
PTR_HASH just_look_up_sym();
|
|
|
|
|
PTR_HASH just_look_up_sym_in_scope();
|
|
|
|
|
PTR_HASH look_up_op();
|
|
|
|
|
PTR_SYMB make_constant();
|
|
|
|
|
PTR_SYMB make_scalar();
|
|
|
|
|
PTR_SYMB make_array();
|
|
|
|
|
PTR_SYMB make_pointer();
|
|
|
|
|
PTR_SYMB make_function();
|
|
|
|
|
PTR_SYMB make_external();
|
|
|
|
|
PTR_SYMB make_intrinsic();
|
|
|
|
|
PTR_SYMB make_procedure();
|
|
|
|
|
PTR_SYMB make_process();
|
|
|
|
|
PTR_SYMB make_program();
|
|
|
|
|
PTR_SYMB make_module();
|
|
|
|
|
PTR_SYMB make_common();
|
|
|
|
|
PTR_SYMB make_parallel_region();
|
|
|
|
|
PTR_SYMB make_derived_type();
|
|
|
|
|
PTR_SYMB make_local_entity();
|
|
|
|
|
PTR_SYMB make_global_entity();
|
|
|
|
|
PTR_TYPE make_type_node();
|
|
|
|
|
PTR_TYPE lookup_type(), make_type();
|
|
|
|
|
void process_type();
|
|
|
|
|
void process_interface();
|
|
|
|
|
void bind();
|
|
|
|
|
void late_bind_if_needed();
|
|
|
|
|
PTR_SYMB component();
|
|
|
|
|
PTR_SYMB lookup_type_symbol();
|
|
|
|
|
PTR_SYMB resolve_overloading();
|
|
|
|
|
PTR_BFND cur_scope();
|
|
|
|
|
PTR_BFND subroutine_call();
|
|
|
|
|
PTR_BFND process_call();
|
|
|
|
|
PTR_LLND deal_with_options();
|
|
|
|
|
PTR_LLND intrinsic_op_node();
|
|
|
|
|
PTR_LLND defined_op_node();
|
|
|
|
|
int is_substring_ref();
|
|
|
|
|
int is_array_section_ref();
|
|
|
|
|
PTR_LLND dim_expr();
|
|
|
|
|
PTR_BFND exit_stat();
|
|
|
|
|
PTR_BFND make_do();
|
|
|
|
|
PTR_BFND make_pardo();
|
|
|
|
|
PTR_BFND make_enddoall();
|
|
|
|
|
PTR_TYPE install_array();
|
|
|
|
|
PTR_SYMB install_entry();
|
|
|
|
|
void install_param_list();
|
|
|
|
|
PTR_LLND construct_entry_list();
|
|
|
|
|
void copy_sym_data();
|
|
|
|
|
PTR_LLND check_and_install();
|
|
|
|
|
PTR_HASH look_up();
|
|
|
|
|
PTR_BFND get_bfnd();
|
|
|
|
|
PTR_BLOB make_blob();
|
|
|
|
|
PTR_LABEL make_label();
|
|
|
|
|
PTR_LABEL make_label_node();
|
|
|
|
|
int is_interface_stat();
|
|
|
|
|
PTR_LLND make_llnd ();
|
|
|
|
|
PTR_LLND make_llnd_label ();
|
|
|
|
|
PTR_TYPE make_sa_type();
|
|
|
|
|
PTR_SYMB procedure_call();
|
|
|
|
|
PTR_BFND proc_list();
|
|
|
|
|
PTR_SYMB set_id_list();
|
|
|
|
|
PTR_LLND set_ll_list();
|
|
|
|
|
PTR_LLND add_to_lowLevelList(), add_to_lowList();
|
|
|
|
|
PTR_BFND set_stat_list() ;
|
|
|
|
|
PTR_BLOB follow_blob();
|
|
|
|
|
PTR_SYMB proc_decl_init();
|
|
|
|
|
PTR_CMNT make_comment();
|
|
|
|
|
PTR_HASH correct_symtab();
|
|
|
|
|
char *copyn();
|
|
|
|
|
char *convic();
|
|
|
|
|
char *StringConcatenation();
|
|
|
|
|
int atoi();
|
|
|
|
|
PTR_BFND make_logif();
|
|
|
|
|
PTR_BFND make_if();
|
|
|
|
|
PTR_BFND make_forall();
|
|
|
|
|
void startproc();
|
|
|
|
|
void match_parameters();
|
|
|
|
|
void make_else();
|
|
|
|
|
void make_elseif();
|
|
|
|
|
void make_endif();
|
|
|
|
|
void make_elsewhere();
|
|
|
|
|
void make_elsewhere_mask();
|
|
|
|
|
void make_endwhere();
|
|
|
|
|
void make_endforall();
|
|
|
|
|
void make_endselect();
|
|
|
|
|
void make_extend();
|
|
|
|
|
void make_endextend();
|
|
|
|
|
void make_section();
|
|
|
|
|
void make_section_extend();
|
|
|
|
|
void doinclude();
|
|
|
|
|
void endproc();
|
|
|
|
|
void err();
|
|
|
|
|
void execerr();
|
|
|
|
|
void flline();
|
|
|
|
|
void warn();
|
|
|
|
|
void warn1();
|
|
|
|
|
void newprog();
|
|
|
|
|
void set_type();
|
|
|
|
|
void dclerr();
|
|
|
|
|
void enddcl();
|
|
|
|
|
void install_const();
|
|
|
|
|
void setimpl();
|
|
|
|
|
void copy_module_scope();
|
|
|
|
|
void delete_symbol();
|
|
|
|
|
void replace_symbol_in_expr();
|
|
|
|
|
long convci();
|
|
|
|
|
void set_expr_type();
|
|
|
|
|
void errstr();
|
|
|
|
|
void yyerror();
|
|
|
|
|
void set_blobs();
|
|
|
|
|
void make_loop();
|
|
|
|
|
void startioctl();
|
|
|
|
|
void endioctl();
|
|
|
|
|
void redefine_func_arg_type();
|
|
|
|
|
int isResultVar();
|
2023-12-06 11:55:35 +03:00
|
|
|
int yylex();
|
2023-09-14 19:43:13 +03:00
|
|
|
|
|
|
|
|
/* used by FORTRAN M */
|
|
|
|
|
PTR_BFND make_processdo();
|
|
|
|
|
PTR_BFND make_processes();
|
|
|
|
|
PTR_BFND make_endprocesses();
|
|
|
|
|
|
|
|
|
|
PTR_BFND make_endparallel();/*OMP*/
|
|
|
|
|
PTR_BFND make_parallel();/*OMP*/
|
|
|
|
|
PTR_BFND make_endsingle();/*OMP*/
|
|
|
|
|
PTR_BFND make_single();/*OMP*/
|
|
|
|
|
PTR_BFND make_endmaster();/*OMP*/
|
|
|
|
|
PTR_BFND make_master();/*OMP*/
|
|
|
|
|
PTR_BFND make_endordered();/*OMP*/
|
|
|
|
|
PTR_BFND make_ordered();/*OMP*/
|
|
|
|
|
PTR_BFND make_endcritical();/*OMP*/
|
|
|
|
|
PTR_BFND make_critical();/*OMP*/
|
|
|
|
|
PTR_BFND make_endsections();/*OMP*/
|
|
|
|
|
PTR_BFND make_sections();/*OMP*/
|
|
|
|
|
PTR_BFND make_ompsection();/*OMP*/
|
|
|
|
|
PTR_BFND make_endparallelsections();/*OMP*/
|
|
|
|
|
PTR_BFND make_parallelsections();/*OMP*/
|
|
|
|
|
PTR_BFND make_endworkshare();/*OMP*/
|
|
|
|
|
PTR_BFND make_workshare();/*OMP*/
|
|
|
|
|
PTR_BFND make_endparallelworkshare();/*OMP*/
|
|
|
|
|
PTR_BFND make_parallelworkshare();/*OMP*/
|
|
|
|
|
|
|
|
|
|
%}
|
|
|
|
|
%%
|
|
|
|
|
|
|
|
|
|
program: { $$ = BFNULL; }
|
|
|
|
|
| program stat EOLN
|
|
|
|
|
{ $$ = set_stat_list($1,$2); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
stat: thislabel entry cmnt
|
|
|
|
|
{ lastwasbranch = NO; $$ = BFNULL; }
|
|
|
|
|
| thislabel spec cmnt
|
|
|
|
|
{
|
|
|
|
|
if ($2 != BFNULL)
|
|
|
|
|
{
|
|
|
|
|
$2->label = $1;
|
|
|
|
|
$$ = $2;
|
|
|
|
|
if (is_openmp_stmt) { /*OMP*/
|
|
|
|
|
is_openmp_stmt = 0;
|
|
|
|
|
if($2) { /*OMP*/
|
|
|
|
|
if ($2->decl_specs != -BIT_OPENMP) $2->decl_specs = BIT_OPENMP; /*OMP*/
|
|
|
|
|
} /*OMP*/
|
|
|
|
|
} /*OMP*/
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| thislabel exec cmnt
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
if(lastwasbranch && ! thislabel)
|
|
|
|
|
/*if (warn_all)
|
|
|
|
|
warn("statement cannot be reached", 36);*/
|
|
|
|
|
lastwasbranch = thiswasbranch;
|
|
|
|
|
thiswasbranch = NO;
|
|
|
|
|
if($2) $2->label = $1;
|
|
|
|
|
if($1 && $2) $1->statbody = $2; /*8.11.06 podd*/
|
|
|
|
|
if($1) {
|
|
|
|
|
/*$1->statbody = $2;*/ /*8.11.06 podd*/
|
|
|
|
|
if($1->labtype == LABFORMAT)
|
|
|
|
|
err("label already that of a format",39);
|
|
|
|
|
else
|
|
|
|
|
$1->labtype = LABEXEC;
|
|
|
|
|
}
|
|
|
|
|
if (is_openmp_stmt) { /*OMP*/
|
|
|
|
|
is_openmp_stmt = 0;
|
|
|
|
|
if($2) { /*OMP*/
|
|
|
|
|
if ($2->decl_specs != -BIT_OPENMP) $2->decl_specs = BIT_OPENMP; /*OMP*/
|
|
|
|
|
} /*OMP*/
|
|
|
|
|
} /*OMP*/
|
|
|
|
|
for (p = pred_bfnd; $1 &&
|
|
|
|
|
((p->variant == FOR_NODE)||(p->variant == WHILE_NODE)) &&
|
|
|
|
|
(p->entry.for_node.doend) &&
|
|
|
|
|
(p->entry.for_node.doend->stateno == $1->stateno);
|
|
|
|
|
p = p->control_parent)
|
|
|
|
|
++end_group;
|
|
|
|
|
$$ = $2;
|
|
|
|
|
}
|
|
|
|
|
| thislabel INCLUDE filename
|
|
|
|
|
{ /* PTR_LLND p; */
|
|
|
|
|
doinclude( $3 );
|
|
|
|
|
/* p = make_llnd(fi, STRING_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = $3;
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
$$ = get_bfnd(fi, INCLUDE_STAT, SMNULL, p, LLNULL); */
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
| thislabel UNKNOWN
|
|
|
|
|
{
|
|
|
|
|
err("Unclassifiable statement", 10);
|
|
|
|
|
flline();
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
};
|
|
|
|
|
| COMMENT
|
|
|
|
|
{ PTR_CMNT p;
|
|
|
|
|
PTR_BFND bif;
|
|
|
|
|
|
|
|
|
|
if (last_bfnd && last_bfnd->control_parent &&((last_bfnd->control_parent->variant == LOGIF_NODE)
|
|
|
|
|
||(last_bfnd->control_parent->variant == FORALL_STAT)))
|
|
|
|
|
bif = last_bfnd->control_parent;
|
|
|
|
|
else
|
|
|
|
|
bif = last_bfnd;
|
|
|
|
|
p=bif->entry.Template.cmnt_ptr;
|
|
|
|
|
if(p)
|
|
|
|
|
p->string = StringConcatenation(p->string,commentbuf);
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
p = make_comment(fi,commentbuf, FULL);
|
|
|
|
|
bif->entry.Template.cmnt_ptr = p;
|
|
|
|
|
}
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| error
|
|
|
|
|
{
|
|
|
|
|
flline(); needkwd = NO; inioctl = NO;
|
|
|
|
|
/*!!!*/
|
|
|
|
|
opt_kwd_ = NO; intonly = NO; opt_kwd_hedr = NO; opt_kwd_r = NO; as_op_kwd_= NO; optcorner = NO;
|
|
|
|
|
yyerrok; yyclearin; $$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
thislabel: LABEL
|
|
|
|
|
{
|
|
|
|
|
if(yystno)
|
|
|
|
|
{
|
|
|
|
|
$$ = thislabel = make_label_node(fi,yystno);
|
|
|
|
|
thislabel->scope = cur_scope();
|
|
|
|
|
if (thislabel->labdefined && (thislabel->scope == cur_scope()))
|
|
|
|
|
errstr("Label %s already defined",convic(thislabel->stateno),40);
|
|
|
|
|
else
|
|
|
|
|
thislabel->labdefined = YES;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
$$ = thislabel = LBNULL;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
entry: PROGRAM new_prog progname
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced PROGRAM statement", 33);
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR, $3, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
$3->entry.prog_decl.prog_hedr=p;
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| BLOCKDATA new_prog blokname
|
|
|
|
|
{ PTR_BFND q = BFNULL;
|
|
|
|
|
|
|
|
|
|
$3->variant = PROCEDURE_NAME;
|
|
|
|
|
$3->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
q = get_bfnd(fi,BLOCK_DATA, $3, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(q, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(q, NO);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| SUBROUTINE new_prog procname arglist
|
|
|
|
|
{
|
|
|
|
|
install_param_list($3, $4, LLNULL, PROCEDURE_NAME);
|
|
|
|
|
/* if there is only a control end the control parent is not set */
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| proc_attr SUBROUTINE new_prog procname arglist
|
|
|
|
|
{ install_param_list($4, $5, LLNULL, PROCEDURE_NAME);
|
|
|
|
|
if($1->variant == RECURSIVE_OP)
|
|
|
|
|
$4->attr = $4->attr | RECURSIVE_BIT;
|
|
|
|
|
pred_bfnd->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
}
|
|
|
|
|
| FUNCTION new_prog funcname arglist opt_result_clause
|
|
|
|
|
{
|
|
|
|
|
install_param_list($3, $4, $5, FUNCTION_NAME);
|
|
|
|
|
pred_bfnd->entry.Template.ll_ptr1 = $5;
|
|
|
|
|
}
|
|
|
|
|
| typedfunc arglist opt_result_clause
|
|
|
|
|
{
|
|
|
|
|
install_param_list($1, $2, $3, FUNCTION_NAME);
|
|
|
|
|
pred_bfnd->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
}
|
|
|
|
|
| ENTRY name arglist opt_result_clause
|
|
|
|
|
{PTR_BFND p, bif;
|
|
|
|
|
PTR_SYMB q = SMNULL;
|
|
|
|
|
PTR_LLND l = LLNULL;
|
|
|
|
|
|
|
|
|
|
if(parstate==OUTSIDE || procclass==CLMAIN || procclass==CLBLOCK)
|
|
|
|
|
err("Misplaced ENTRY statement", 35);
|
|
|
|
|
|
|
|
|
|
bif = cur_scope();
|
|
|
|
|
if (bif->variant == FUNC_HEDR) {
|
|
|
|
|
q = make_function($2, bif->entry.Template.symbol->type, LOCAL);
|
|
|
|
|
l = construct_entry_list(q, $3, FUNCTION_NAME);
|
|
|
|
|
}
|
|
|
|
|
else if ((bif->variant == PROC_HEDR) ||
|
|
|
|
|
(bif->variant == PROS_HEDR) || /* added for FORTRAN M */
|
|
|
|
|
(bif->variant == PROG_HEDR)) {
|
|
|
|
|
q = make_procedure($2,LOCAL);
|
|
|
|
|
l = construct_entry_list(q, $3, PROCEDURE_NAME);
|
|
|
|
|
}
|
|
|
|
|
p = get_bfnd(fi,ENTRY_STAT, q, l, $4, LLNULL);
|
|
|
|
|
set_blobs(p, pred_bfnd, SAME_GROUP);
|
|
|
|
|
q->decl = YES; /*4.02.03*/
|
|
|
|
|
q->entry.proc_decl.proc_hedr = p; /*5.02.03*/
|
|
|
|
|
}
|
|
|
|
|
| MODULE new_prog name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_BFND p;
|
|
|
|
|
/*
|
|
|
|
|
s = make_global_entity($3, MODULE_NAME, global_default, NO);
|
|
|
|
|
s->decl = YES;
|
|
|
|
|
p = get_bfnd(fi, MODULE_STMT, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
s->entry.Template.func_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
*/
|
|
|
|
|
/*position = IN_MODULE;*/
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
s = make_module($3);
|
|
|
|
|
s->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced MODULE statement", 33);
|
|
|
|
|
p = get_bfnd(fi, MODULE_STMT, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
s->entry.Template.func_hedr = p; /* !!!????*/
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_MODULE; /*IN_PROC*/
|
|
|
|
|
privateall = 0;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
new_prog: { newprog();
|
|
|
|
|
if (position == IN_OUTSIDE)
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
else if (position != IN_INTERNAL_PROC){
|
|
|
|
|
if(!is_interface_stat(pred_bfnd))
|
|
|
|
|
position--;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
if(!is_interface_stat(pred_bfnd))
|
|
|
|
|
err("Internal procedures can not contain procedures",304);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
proc_attr: RECURSIVE needkeyword
|
|
|
|
|
{ $$ = make_llnd(fi, RECURSIVE_OP, LLNULL, LLNULL, SMNULL); }
|
|
|
|
|
| PURE needkeyword
|
|
|
|
|
{ $$ = make_llnd(fi, PURE_OP, LLNULL, LLNULL, SMNULL); }
|
|
|
|
|
| ELEMENTAL needkeyword
|
|
|
|
|
{ $$ = make_llnd(fi, ELEMENTAL_OP, LLNULL, LLNULL, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
procname: name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
$$ = make_procedure($1, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
/* if (pred_bfnd != global_bfnd)
|
|
|
|
|
{
|
|
|
|
|
err("Misplaced SUBROUTINE statement", 34);
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
p = get_bfnd(fi,PROC_HEDR, $$, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
$$->entry.proc_decl.proc_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
funcname: name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
$$ = make_function($1, TYNULL, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
/* if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced FUNCTION statement", 34); */
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
$$->entry.func_decl.func_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
typedfunc: type FUNCTION new_prog name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
$$ = make_function($4, $1, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
l = make_llnd(fi, TYPE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->type = $1;
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, l, LLNULL);
|
|
|
|
|
$$->entry.func_decl.func_hedr = p;
|
|
|
|
|
/* if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced FUNCTION statement", 34);*/
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
/*
|
|
|
|
|
$$ = make_function($4, $1, LOCAL);
|
|
|
|
|
$$->decl = YES;
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
if (pred_bfnd != global_bfnd)
|
|
|
|
|
errstr("cftn.gram: misplaced SUBROUTINE statement.");
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
*/
|
|
|
|
|
}
|
|
|
|
|
| type proc_attr FUNCTION new_prog name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
$$ = make_function($5, $1, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
if($2->variant == RECURSIVE_OP)
|
|
|
|
|
$$->attr = $$->attr | RECURSIVE_BIT;
|
|
|
|
|
l = make_llnd(fi, TYPE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->type = $1;
|
|
|
|
|
/* if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced FUNCTION statement", 34);*/
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, l, $2);
|
|
|
|
|
$$->entry.func_decl.func_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
}
|
|
|
|
|
| proc_attr FUNCTION new_prog name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
$$ = make_function($4, TYNULL, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
if($1->variant == RECURSIVE_OP)
|
|
|
|
|
$$->attr = $$->attr | RECURSIVE_BIT;
|
|
|
|
|
/*if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced FUNCTION statement",34);*/
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, LLNULL, $1);
|
|
|
|
|
$$->entry.func_decl.func_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
}
|
|
|
|
|
| proc_attr type FUNCTION new_prog name
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
$$ = make_function($5, $2, LOCAL);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
if($1->variant == RECURSIVE_OP)
|
|
|
|
|
$$->attr = $$->attr | RECURSIVE_BIT;
|
|
|
|
|
l = make_llnd(fi, TYPE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->type = $2;
|
|
|
|
|
/* if (pred_bfnd != global_bfnd)
|
|
|
|
|
err("Misplaced FUNCTION statement",34);*/
|
|
|
|
|
p = get_bfnd(fi,FUNC_HEDR, $$, LLNULL, l, $1);
|
|
|
|
|
$$->entry.func_decl.func_hedr = p;
|
|
|
|
|
set_blobs(p, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_result_clause: needkeyword keywordoff
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| needkeyword RESULT LEFTPAR name RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = make_scalar($4, TYNULL, LOCAL);
|
|
|
|
|
$$ = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
name: IDENTIFIER
|
|
|
|
|
{ $$ = look_up_sym(yytext); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
progname: { $$ = make_program(look_up_sym("_MAIN")); }
|
|
|
|
|
| name
|
|
|
|
|
{
|
|
|
|
|
$$ = make_program($1);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
blokname: { $$ = make_program(look_up_sym("_BLOCK")); }
|
|
|
|
|
| name
|
|
|
|
|
{
|
|
|
|
|
$$ = make_program($1);
|
|
|
|
|
$$->decl = YES; /* variable declaration has been seen. */
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
arglist:
|
|
|
|
|
{ $$ = SMNULL; }
|
|
|
|
|
| LEFTPAR RIGHTPAR
|
|
|
|
|
{ $$ = SMNULL; }
|
|
|
|
|
| LEFTPAR args RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
args: arg
|
|
|
|
|
| args COMMA arg
|
|
|
|
|
{ $$ = set_id_list($1, $3); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
arg: name
|
|
|
|
|
{
|
|
|
|
|
$$ = make_scalar($1, TYNULL, IO);
|
|
|
|
|
}
|
|
|
|
|
| ASTER
|
|
|
|
|
{ $$ = make_scalar(look_up_sym("*"), TYNULL, IO); } /*star_symb*/
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
filename: CHAR_CONSTANT
|
|
|
|
|
{ char *s;
|
|
|
|
|
|
|
|
|
|
s = copyn(yyleng+1, yytext);
|
|
|
|
|
s[yyleng] = '\0';
|
|
|
|
|
$$ = s;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
needkeyword:
|
|
|
|
|
{ needkwd = 1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
keywordoff:
|
|
|
|
|
{ needkwd = NO; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/* The scanner checks if the keyword is ONLY. */
|
|
|
|
|
keyword_if_colon_follow:
|
|
|
|
|
{ colon_flag = YES; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* Grammar for declarations
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
spec: type_dcl
|
|
|
|
|
| end_type
|
|
|
|
|
| dcl
|
|
|
|
|
| common
|
|
|
|
|
| dimension
|
|
|
|
|
| dvm_specification /* FDVM */
|
|
|
|
|
| external
|
|
|
|
|
| intrinsic
|
|
|
|
|
| equivalence
|
|
|
|
|
| implicit
|
|
|
|
|
| attrib
|
|
|
|
|
| namelist
|
|
|
|
|
| data
|
|
|
|
|
| SAVE in_dcl
|
|
|
|
|
{
|
|
|
|
|
saveall = YES;
|
|
|
|
|
$$ = get_bfnd(fi,SAVE_DECL, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| SAVE in_dcl opt_double_colon savelist
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi,SAVE_DECL, SMNULL, $4, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| FORMAT inside
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,STMT_STR, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = copys(stmtbuf);
|
|
|
|
|
$$ = get_bfnd(fi,FORMAT_STAT, SMNULL, p, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| PARAMETER in_dcl LEFTPAR paramlist RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi,PARAM_DECL, SMNULL, $4, LLNULL, LLNULL); }
|
|
|
|
|
| intent
|
|
|
|
|
| optional
|
|
|
|
|
| public
|
|
|
|
|
| private
|
|
|
|
|
| sequence
|
|
|
|
|
| allocatable
|
|
|
|
|
| pointer
|
|
|
|
|
| target
|
|
|
|
|
| interface
|
|
|
|
|
| use_stat
|
|
|
|
|
| module_proc_stmt
|
|
|
|
|
| static
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
interface: INTERFACE in_dcl
|
|
|
|
|
{ $$ = get_bfnd(fi, INTERFACE_STMT, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| INTERFACE in_dcl name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_procedure($3, LOCAL);
|
|
|
|
|
s->variant = INTERFACE_NAME;
|
|
|
|
|
$$ = get_bfnd(fi, INTERFACE_STMT, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| INTERFACEOPERATOR in_dcl LEFTPAR operator RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_function($4, global_default, LOCAL);
|
|
|
|
|
s->variant = INTERFACE_NAME;
|
|
|
|
|
$$ = get_bfnd(fi, INTERFACE_OPERATOR, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| INTERFACEASSIGNMENT in_dcl LEFTPAR EQUAL RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
s = make_procedure(look_up_sym("="), LOCAL);
|
|
|
|
|
s->variant = INTERFACE_NAME;
|
|
|
|
|
$$ = get_bfnd(fi, INTERFACE_ASSIGNMENT, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| ENDINTERFACE opt_unit_name
|
|
|
|
|
{ parstate = INDCL;
|
|
|
|
|
$$ = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
/*process_interface($$);*/ /*podd 01.02.03*/
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
defined_op: DEFINED_OPERATOR
|
|
|
|
|
{ $$ = look_up_sym(yytext); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
operator: defined_op
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| intrinsic_op
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intrinsic_op: PLUS
|
|
|
|
|
{ $$ = look_up_op(PLUS); }
|
|
|
|
|
| MINUS
|
|
|
|
|
{ $$ = look_up_op(MINUS); }
|
|
|
|
|
| ASTER
|
|
|
|
|
{ $$ = look_up_op(ASTER); }
|
|
|
|
|
| DASTER
|
|
|
|
|
{ $$ = look_up_op(DASTER); }
|
|
|
|
|
| SLASH
|
|
|
|
|
{ $$ = look_up_op(SLASH); }
|
|
|
|
|
| DSLASH
|
|
|
|
|
{ $$ = look_up_op(DSLASH); }
|
|
|
|
|
| AND
|
|
|
|
|
{ $$ = look_up_op(AND); }
|
|
|
|
|
| OR
|
|
|
|
|
{ $$ = look_up_op(OR); }
|
|
|
|
|
| XOR
|
|
|
|
|
{ $$ = look_up_op(XOR); }
|
|
|
|
|
| NOT
|
|
|
|
|
{ $$ = look_up_op(NOT); }
|
|
|
|
|
| EQ
|
|
|
|
|
{ $$ = look_up_op(EQ); }
|
|
|
|
|
| NE
|
|
|
|
|
{ $$ = look_up_op(NE); }
|
|
|
|
|
| GT
|
|
|
|
|
{ $$ = look_up_op(GT); }
|
|
|
|
|
| GE
|
|
|
|
|
{ $$ = look_up_op(GE); }
|
|
|
|
|
| LT
|
|
|
|
|
{ $$ = look_up_op(LT); }
|
|
|
|
|
| LE
|
|
|
|
|
{ $$ = look_up_op(LE); }
|
|
|
|
|
| NEQV
|
|
|
|
|
{ $$ = look_up_op(NEQV); }
|
|
|
|
|
| EQV
|
|
|
|
|
{ $$ = look_up_op(EQV); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
type_dcl: TYPE_DECL in_dcl opt_double_colon name
|
|
|
|
|
{
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
type_var = s = make_derived_type($4, TYNULL, LOCAL);
|
|
|
|
|
$$ = get_bfnd(fi, STRUCT_DECL, s, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| TYPE_DECL COMMA in_dcl needkeyword access_spec opt_double_colon name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
type_var = s = make_derived_type($7, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
$$ = get_bfnd(fi, STRUCT_DECL, s, $5, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
end_type: ENDTYPE in_dcl
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
if (type_var != SMNULL)
|
|
|
|
|
process_type(type_var, $$);
|
|
|
|
|
type_var = SMNULL;
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
}
|
|
|
|
|
| ENDTYPE in_dcl name
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
if (type_var != SMNULL)
|
|
|
|
|
process_type(type_var, $$);
|
|
|
|
|
type_var = SMNULL;
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dcl: type options name in_dcl dims lengspec initial_value
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r, l;
|
|
|
|
|
/* PTR_SYMB s;*/
|
|
|
|
|
PTR_TYPE t;
|
|
|
|
|
int type_opts;
|
|
|
|
|
|
|
|
|
|
vartype = $1;
|
|
|
|
|
if($6 && vartype->variant != T_STRING)
|
|
|
|
|
errstr("Non character entity %s has length specification",$3->ident,41);
|
|
|
|
|
t = make_type_node(vartype, $6);
|
|
|
|
|
type_opts = type_options;
|
|
|
|
|
if ($5) type_opts = type_opts | DIMENSION_BIT;
|
|
|
|
|
if ($5)
|
|
|
|
|
q = deal_with_options($3, t, type_opts, $5, ndim, $7, $5);
|
|
|
|
|
else q = deal_with_options($3, t, type_opts, attr_dims, attr_ndim, $7, $5);
|
|
|
|
|
r = make_llnd(fi, EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
l = make_llnd(fi, TYPE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->type = vartype;
|
|
|
|
|
$$ = get_bfnd(fi,VAR_DECL, SMNULL, r, l, $2);
|
|
|
|
|
}
|
|
|
|
|
| dcl COMMA name dims lengspec initial_value
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
/* PTR_SYMB s;*/
|
|
|
|
|
PTR_TYPE t;
|
|
|
|
|
int type_opts;
|
|
|
|
|
if($5 && vartype->variant != T_STRING)
|
|
|
|
|
errstr("Non character entity %s has length specification",$3->ident,41);
|
|
|
|
|
t = make_type_node(vartype, $5);
|
|
|
|
|
type_opts = type_options;
|
|
|
|
|
if ($4) type_opts = type_opts | DIMENSION_BIT;
|
|
|
|
|
if ($4)
|
|
|
|
|
q = deal_with_options($3, t, type_opts, $4, ndim, $6, $4);
|
|
|
|
|
else q = deal_with_options($3, t, type_opts, attr_dims, attr_ndim, $6, $4);
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
options:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| COLON COLON
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| COMMA needkeyword attr_spec_list COLON COLON
|
|
|
|
|
{ $$ = $3; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
attr_spec_list: attr_spec
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| attr_spec_list COMMA needkeyword attr_spec
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
attr_spec: PARAMETER
|
|
|
|
|
{ type_options = type_options | PARAMETER_BIT;
|
|
|
|
|
$$ = make_llnd(fi, PARAMETER_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| access_spec
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| ALLOCATABLE
|
|
|
|
|
{ type_options = type_options | ALLOCATABLE_BIT;
|
|
|
|
|
$$ = make_llnd(fi, ALLOCATABLE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| DIMENSION dims
|
|
|
|
|
{ type_options = type_options | DIMENSION_BIT;
|
|
|
|
|
attr_ndim = ndim;
|
|
|
|
|
attr_dims = $2;
|
|
|
|
|
$$ = make_llnd(fi, DIMENSION_OP, $2, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| EXTERNAL
|
|
|
|
|
{ type_options = type_options | EXTERNAL_BIT;
|
|
|
|
|
$$ = make_llnd(fi, EXTERNAL_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| INTENT LEFTPAR intent_spec RIGHTPAR
|
|
|
|
|
{ $$ = $3; }
|
|
|
|
|
| INTRINSIC
|
|
|
|
|
{ type_options = type_options | INTRINSIC_BIT;
|
|
|
|
|
$$ = make_llnd(fi, INTRINSIC_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| OPTIONAL
|
|
|
|
|
{ type_options = type_options | OPTIONAL_BIT;
|
|
|
|
|
$$ = make_llnd(fi, OPTIONAL_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| POINTER
|
|
|
|
|
{ type_options = type_options | POINTER_BIT;
|
|
|
|
|
$$ = make_llnd(fi, POINTER_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| SAVE
|
|
|
|
|
{ type_options = type_options | SAVE_BIT;
|
|
|
|
|
$$ = make_llnd(fi, SAVE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| STATIC
|
|
|
|
|
{ type_options = type_options | SAVE_BIT;
|
|
|
|
|
$$ = make_llnd(fi, STATIC_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| TARGET
|
|
|
|
|
{ type_options = type_options | TARGET_BIT;
|
|
|
|
|
$$ = make_llnd(fi, TARGET_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intent_spec: needkeyword IN
|
|
|
|
|
{ type_options = type_options | IN_BIT; type_opt = IN_BIT;
|
|
|
|
|
$$ = make_llnd(fi, IN_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| needkeyword OUT
|
|
|
|
|
{ type_options = type_options | OUT_BIT; type_opt = OUT_BIT;
|
|
|
|
|
$$ = make_llnd(fi, OUT_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| needkeyword INOUT
|
|
|
|
|
{ type_options = type_options | INOUT_BIT; type_opt = INOUT_BIT;
|
|
|
|
|
$$ = make_llnd(fi, INOUT_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
access_spec: PUBLIC
|
|
|
|
|
{ type_options = type_options | PUBLIC_BIT;
|
|
|
|
|
type_opt = PUBLIC_BIT;
|
|
|
|
|
$$ = make_llnd(fi, PUBLIC_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| PRIVATE
|
|
|
|
|
{ type_options = type_options | PRIVATE_BIT;
|
|
|
|
|
type_opt = PRIVATE_BIT;
|
|
|
|
|
$$ = make_llnd(fi, PRIVATE_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intent: INTENT in_dcl LEFTPAR intent_spec RIGHTPAR opt_double_colon name
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_scalar($7, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, INTENT_STMT, SMNULL, r, $4, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| intent COMMA name
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_scalar($3, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
optional: OPTIONAL in_dcl opt_double_colon name
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_scalar($4, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | OPTIONAL_BIT;
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, OPTIONAL_STMT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| optional COMMA name
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_scalar($3, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | OPTIONAL_BIT;
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
static: STATIC in_dcl opt_double_colon var
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = $4->entry.Template.symbol;
|
|
|
|
|
s->attr = s->attr | SAVE_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, STATIC_STMT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| static COMMA var
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = $3->entry.Template.symbol;
|
|
|
|
|
s->attr = s->attr | SAVE_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
private: PRIVATE in_dcl
|
|
|
|
|
{
|
|
|
|
|
privateall = 1;
|
|
|
|
|
$$ = get_bfnd(fi, PRIVATE_STMT, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| PRIVATE in_dcl opt_double_colon private_attr use_name_list
|
|
|
|
|
{
|
|
|
|
|
/*type_options = type_options | PRIVATE_BIT;*/
|
|
|
|
|
$$ = get_bfnd(fi, PRIVATE_STMT, SMNULL, $5, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
private_attr:
|
|
|
|
|
{type_opt = PRIVATE_BIT;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
sequence: SEQUENCE in_dcl
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi, SEQUENCE_STMT, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
public: PUBLIC in_dcl
|
|
|
|
|
{
|
|
|
|
|
/*saveall = YES;*/ /*14.03.03*/
|
|
|
|
|
$$ = get_bfnd(fi, PUBLIC_STMT, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| PUBLIC in_dcl opt_double_colon public_attr use_name_list
|
|
|
|
|
{
|
|
|
|
|
/*type_options = type_options | PUBLIC_BIT;*/
|
|
|
|
|
$$ = get_bfnd(fi, PUBLIC_STMT, SMNULL, $5, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
public_attr:
|
|
|
|
|
{type_opt = PUBLIC_BIT;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
type: typespec opt_key_hedr selector opt_key_hedr
|
|
|
|
|
{
|
|
|
|
|
type_options = 0;
|
|
|
|
|
/* following block added by dbg */
|
|
|
|
|
ndim = 0;
|
|
|
|
|
attr_ndim = 0;
|
|
|
|
|
attr_dims = LLNULL;
|
|
|
|
|
/* end section added by dbg */
|
|
|
|
|
$$ = make_type_node($1, $3);
|
|
|
|
|
}
|
|
|
|
|
| TYPE LEFTPAR name RIGHTPAR opt_key_hedr
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
|
|
|
|
|
type_options = 0;
|
|
|
|
|
ndim = 0;
|
|
|
|
|
attr_ndim = 0;
|
|
|
|
|
attr_dims = LLNULL;
|
|
|
|
|
t = lookup_type($3);
|
|
|
|
|
vartype = t;
|
|
|
|
|
$$ = make_type_node(t, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_key_hedr:
|
|
|
|
|
{opt_kwd_hedr = YES;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
attrib: att_type name
|
|
|
|
|
|
|
|
|
|
{ PTR_TYPE p;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
s = $2->id_attr;
|
|
|
|
|
if (s)
|
|
|
|
|
s->attr = $1;
|
|
|
|
|
else {
|
|
|
|
|
p = undeftype ? global_unknown : impltype[*$2->ident - 'a'];
|
|
|
|
|
s = install_entry($2, SOFT);
|
|
|
|
|
s->attr = $1;
|
|
|
|
|
set_type(s, p, LOCAL);
|
|
|
|
|
}
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, $2->id_attr);
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi,ATTR_DECL, SMNULL, q, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| attrib COMMA name
|
|
|
|
|
|
|
|
|
|
{ PTR_TYPE p;
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
int att;
|
|
|
|
|
|
|
|
|
|
att = $1->entry.Template.ll_ptr1->entry.Template.ll_ptr1->
|
|
|
|
|
entry.Template.symbol->attr;
|
|
|
|
|
s = $3->id_attr;
|
|
|
|
|
if (s)
|
|
|
|
|
s->attr = att;
|
|
|
|
|
else {
|
|
|
|
|
p = undeftype ? global_unknown : impltype[*$3->ident - 'a'];
|
|
|
|
|
s = install_entry($3, SOFT);
|
|
|
|
|
s->attr = att;
|
|
|
|
|
set_type(s, p, LOCAL);
|
|
|
|
|
}
|
|
|
|
|
q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, $3->id_attr);
|
|
|
|
|
for (r = $1->entry.Template.ll_ptr1;
|
|
|
|
|
r->entry.list.next;
|
|
|
|
|
r = r->entry.list.next) ;
|
|
|
|
|
r->entry.list.next = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
att_type: GLOBAL_A
|
|
|
|
|
{ $$ = ATT_GLOBAL; }
|
|
|
|
|
| CLUSTER
|
|
|
|
|
{ $$ = ATT_CLUSTER; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
opt_attr:
|
|
|
|
|
| TASK_GLOBAL
|
|
|
|
|
| PROCESS_GLOBAL
|
|
|
|
|
| TASK_CLUSTER
|
|
|
|
|
| PROCESS_CLUSTER
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
typespec: typename
|
|
|
|
|
{
|
|
|
|
|
/* varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); */
|
|
|
|
|
vartype = $1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
typename: INTEGER { $$ = global_int; }
|
|
|
|
|
| REAL { $$ = global_float; }
|
|
|
|
|
| COMPLEX { $$ = global_complex; }
|
|
|
|
|
| DOUBLEPRECISION { $$ = global_double; }
|
|
|
|
|
| DOUBLECOMPLEX { $$ = global_dcomplex; }
|
|
|
|
|
| LOGICAL { $$ = global_bool; }
|
|
|
|
|
| CHARACTER { $$ = global_string; }
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
lengspec:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| proper_lengspec
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
proper_lengspec: ASTER intonlyon integer_constant intonlyoff opt_key_hedr
|
|
|
|
|
{ $$ = make_llnd(fi, LEN_OP, $3, LLNULL, SMNULL); }
|
|
|
|
|
| ASTER intonlyon LEFTPAR intonlyoff ASTER RIGHTPAR
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->entry.string_val = (char *)"*";
|
|
|
|
|
$$ = make_llnd(fi, LEN_OP, l,l, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| ASTER intonlyon LEFTPAR intonlyoff expr RIGHTPAR
|
|
|
|
|
{$$ = make_llnd(fi, LEN_OP, $5, $5, SMNULL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
selector:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| proper_lengspec
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| LEFTPAR in_ioctl clause end_ioctl RIGHTPAR
|
|
|
|
|
{ /*$$ = make_llnd(fi, PAREN_OP, $2, LLNULL, SMNULL);*/ $$ = $3; }
|
|
|
|
|
| LEFTPAR in_ioctl clause end_ioctl COMMA in_ioctl clause end_ioctl RIGHTPAR
|
|
|
|
|
/* | LEFTPAR in_ioctl clause COMMA clause RIGHTPAR
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
l = make_llnd(fi, CONS, $2, $4, SMNULL);
|
|
|
|
|
$$ = make_llnd(fi, PAREN_OP, l, LLNULL, SMNULL);}
|
|
|
|
|
*/
|
|
|
|
|
{ if($7->variant==LENGTH_OP && $3->variant==$7->variant)
|
|
|
|
|
$7->variant=KIND_OP;
|
|
|
|
|
$$ = make_llnd(fi, CONS, $3, $7, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
clause: expr
|
|
|
|
|
{ if(vartype->variant == T_STRING)
|
|
|
|
|
$$ = make_llnd(fi,LENGTH_OP,$1,LLNULL,SMNULL);
|
|
|
|
|
else
|
|
|
|
|
$$ = make_llnd(fi,KIND_OP,$1,LLNULL,SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| ASTER
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->entry.string_val = (char *)"*";
|
|
|
|
|
$$ = make_llnd(fi,LENGTH_OP,l,LLNULL,SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| nameeq expr
|
|
|
|
|
{ /* $$ = make_llnd(fi, SPEC_PAIR, $2, LLNULL, SMNULL); */
|
|
|
|
|
char *q;
|
|
|
|
|
q = $1->entry.string_val;
|
|
|
|
|
if (strcmp(q, "len") == 0)
|
|
|
|
|
$$ = make_llnd(fi,LENGTH_OP,$2,LLNULL,SMNULL);
|
|
|
|
|
else
|
|
|
|
|
$$ = make_llnd(fi,KIND_OP,$2,LLNULL,SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| nameeq ASTER
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->entry.string_val = (char *)"*";
|
|
|
|
|
$$ = make_llnd(fi,LENGTH_OP,l,LLNULL,SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
end_ioctl:
|
|
|
|
|
{endioctl();}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
int_nameeq_on:
|
|
|
|
|
{ intonly = inioctl = YES; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
int_nameeq_off:
|
|
|
|
|
{ intonly = inioctl = NO; }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
initial_value:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| EQUAL expr
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
|
|
|
|
|
| POINT_TO expr
|
|
|
|
|
{ $$ = make_llnd(fi, POINTST_OP, LLNULL, $2, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dimension: DIMENSION opt_double_colon in_dcl name dims
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
if(! $5) {
|
|
|
|
|
err("No dimensions in DIMENSION statement", 42);
|
|
|
|
|
}
|
|
|
|
|
if(statement_kind == 1) /*DVM-directive*/
|
|
|
|
|
err("No shape specification", 65);
|
|
|
|
|
s = make_array($4, TYNULL, $5, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | DIMENSION_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $5, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $5;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi,DIM_STAT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| dimension COMMA name dims
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND q, r;
|
|
|
|
|
if(! $4) {
|
|
|
|
|
err("No dimensions in DIMENSION statement", 42);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($3, TYNULL, $4, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | DIMENSION_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $4, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $4;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
allocatable: ALLOCATABLE in_dcl opt_double_colon var
|
|
|
|
|
/* ALLOCATABLE in_dcl opt_double_colon name dims lengspec*/
|
|
|
|
|
{/* PTR_SYMB s;*/
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
/*if(!$5) {
|
|
|
|
|
err("No dimensions in ALLOCATABLE statement",305);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($4, TYNULL, $5, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | ALLOCATABLE_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $5, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $5;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
*/
|
|
|
|
|
$4->entry.Template.symbol->attr = $4->entry.Template.symbol->attr | ALLOCATABLE_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, ALLOCATABLE_STMT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| allocatable COMMA var
|
|
|
|
|
/*allocatable COMMA name dims lengspec */
|
|
|
|
|
{ /*PTR_SYMB s;*/
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
/* if(! $4) {
|
|
|
|
|
err("No dimensions in ALLOCATABLE statement",305);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
s = make_array($3, TYNULL, $4, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | ALLOCATABLE_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $4, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $4;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
*/
|
|
|
|
|
$3->entry.Template.symbol->attr = $3->entry.Template.symbol->attr | ALLOCATABLE_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
pointer: POINTER in_dcl opt_double_colon var
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
/* if(! $5) {
|
|
|
|
|
err("No dimensions in POINTER statement",306);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($4, TYNULL, $5, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | POINTER_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $5, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $5;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
/*s = make_pointer( $4->entry.Template.symbol->parent, TYNULL, LOCAL);*/ /*17.02.03*/
|
|
|
|
|
/*$4->entry.Template.symbol->attr = $4->entry.Template.symbol->attr | POINTER_BIT;*/
|
|
|
|
|
s = $4->entry.Template.symbol; /*17.02.03*/
|
|
|
|
|
s->attr = s->attr | POINTER_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, POINTER_STMT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| pointer COMMA var
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
/* if(! $4) {
|
|
|
|
|
err("No dimensions in POINTER statement",306);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($3, TYNULL, $4, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | POINTER_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $4, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $4;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
/*s = make_pointer( $3->entry.Template.symbol->parent, TYNULL, LOCAL);*/ /*17.02.03*/
|
|
|
|
|
/*$3->entry.Template.symbol->attr = $3->entry.Template.symbol->attr | POINTER_BIT;*/
|
|
|
|
|
s = $3->entry.Template.symbol; /*17.02.03*/
|
|
|
|
|
s->attr = s->attr | POINTER_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
target: TARGET in_dcl opt_double_colon var
|
|
|
|
|
{/* PTR_SYMB s;*/
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* if(! $5) {
|
|
|
|
|
err("No dimensions in TARGET statement",307);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($4, TYNULL, $5, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | TARGET_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $5, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $5;
|
|
|
|
|
*/
|
|
|
|
|
$4->entry.Template.symbol->attr = $4->entry.Template.symbol->attr | TARGET_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, TARGET_STMT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| target COMMA var
|
|
|
|
|
{ /*PTR_SYMB s;*/
|
|
|
|
|
PTR_LLND r;
|
|
|
|
|
|
|
|
|
|
/* if(! $4) {
|
|
|
|
|
err("No dimensions in TARGET statement",307);
|
|
|
|
|
}
|
|
|
|
|
s = make_array($3, TYNULL, $4, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | TARGET_BIT;
|
|
|
|
|
q = make_llnd(fi,ARRAY_REF, $4, LLNULL, s);
|
|
|
|
|
s->type->entry.ar_decl.ranges = $4;
|
|
|
|
|
*/
|
|
|
|
|
$3->entry.Template.symbol->attr = $3->entry.Template.symbol->attr | TARGET_BIT;
|
|
|
|
|
r = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
common: COMMON in_dcl var
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
q = make_llnd(fi,COMM_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi,COMM_STAT, SMNULL, q, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| COMMON in_dcl comblock var
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
q = make_llnd(fi,COMM_LIST, p, LLNULL, $3);
|
|
|
|
|
$$ = get_bfnd(fi,COMM_STAT, SMNULL, q, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| common opt_comma comblock opt_comma var
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $5, LLNULL, SMNULL);
|
|
|
|
|
q = make_llnd(fi,COMM_LIST, p, LLNULL, $3);
|
|
|
|
|
add_to_lowList(q, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
| common COMMA var
|
|
|
|
|
{ PTR_LLND p, r;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
/*q = make_llnd(fi,COMM_LIST, p, LLNULL, SMNULL);*/
|
|
|
|
|
for (r = $1->entry.Template.ll_ptr1;
|
|
|
|
|
r->entry.list.next;
|
|
|
|
|
r = r->entry.list.next);
|
|
|
|
|
add_to_lowLevelList(p, r->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
namelist: NAMELIST in_dcl namelist_group ident
|
|
|
|
|
{ PTR_LLND q, r;
|
|
|
|
|
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, $4, LLNULL, SMNULL);
|
|
|
|
|
r = make_llnd(fi,NAMELIST_LIST, q, LLNULL, $3);
|
|
|
|
|
$$ = get_bfnd(fi,NAMELIST_STAT, SMNULL, r, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| namelist opt_comma namelist_group opt_comma ident
|
|
|
|
|
{ PTR_LLND q, r;
|
|
|
|
|
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, $5, LLNULL, SMNULL);
|
|
|
|
|
r = make_llnd(fi,NAMELIST_LIST, q, LLNULL, $3);
|
|
|
|
|
add_to_lowList(r, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
| namelist COMMA ident
|
|
|
|
|
{ PTR_LLND q, r;
|
|
|
|
|
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
for (r = $1->entry.Template.ll_ptr1;
|
|
|
|
|
r->entry.list.next;
|
|
|
|
|
r = r->entry.list.next);
|
|
|
|
|
add_to_lowLevelList(q, r->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
namelist_group: SLASH name SLASH
|
|
|
|
|
{ $$ = make_local_entity($2, NAMELIST_NAME,global_default,LOCAL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
comblock: DSLASH
|
|
|
|
|
{ $$ = NULL; /*make_common(look_up_sym("*"));*/ }
|
|
|
|
|
| SLASH name SLASH
|
|
|
|
|
{ $$ = make_common($2); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
var: name dims
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
if($2) {
|
|
|
|
|
s = make_array($1, TYNULL, $2, ndim, LOCAL);
|
|
|
|
|
s->attr = s->attr | DIMENSION_BIT;
|
|
|
|
|
s->type->entry.ar_decl.ranges = $2;
|
|
|
|
|
$$ = make_llnd(fi,ARRAY_REF, $2, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
s = make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
external: EXTERNAL in_dcl opt_double_colon name
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_external($4, TYNULL);
|
|
|
|
|
s->attr = s->attr | EXTERNAL_BIT;
|
|
|
|
|
q = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi,EXTERN_STAT, SMNULL, p, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| external COMMA name
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_external($3, TYNULL);
|
|
|
|
|
s->attr = s->attr | EXTERNAL_BIT;
|
|
|
|
|
p = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(q, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intrinsic: INTRINSIC in_dcl opt_double_colon name
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_intrinsic($4, TYNULL); /*make_function($3, TYNULL, NO);*/
|
|
|
|
|
s->attr = s->attr | INTRINSIC_BIT;
|
|
|
|
|
q = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi,INTRIN_STAT, SMNULL, p,
|
|
|
|
|
LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| intrinsic COMMA name
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_intrinsic($3, TYNULL); /* make_function($3, TYNULL, NO);*/
|
|
|
|
|
s->attr = s->attr | INTRINSIC_BIT;
|
|
|
|
|
p = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(q, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
equivalence: EQUIVALENCE in_dcl equivset
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi,EQUI_STAT, SMNULL, $3,
|
|
|
|
|
LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| equivalence COMMA equivset
|
|
|
|
|
{
|
|
|
|
|
add_to_lowLevelList($3, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
equivset: LEFTPAR equivlist RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,EQUI_LIST, $2, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
equivlist: equi_object COMMA equi_object
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, $1, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| equivlist COMMA equi_object
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(p, $1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
equi_object: name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s=make_scalar($1,TYNULL,LOCAL);
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
s->attr = s->attr | EQUIVALENCE_BIT;
|
|
|
|
|
/*$$=$1; $$->entry.Template.symbol->attr = $$->entry.Template.symbol->attr | EQUIVALENCE_BIT; */
|
|
|
|
|
}
|
|
|
|
|
| name LEFTPAR subscript_list RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s=make_array($1,TYNULL,LLNULL,0,LOCAL);
|
|
|
|
|
$$ = make_llnd(fi,ARRAY_REF, $3, LLNULL, s);
|
|
|
|
|
s->attr = s->attr | EQUIVALENCE_BIT;
|
|
|
|
|
/*$$->entry.Template.symbol->attr = $$->entry.Template.symbol->attr | EQUIVALENCE_BIT; */
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* { $$ = $1;
|
|
|
|
|
$$->entry.Template.symbol->attr = $$->entry.Template.symbol->attr | EQUIVALENCE_BIT;
|
|
|
|
|
$$->variant == ARRAY_REF;
|
|
|
|
|
$$->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
| asubstring
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
data: data1
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
data_stat = NO;
|
|
|
|
|
p = make_llnd(fi,STMT_STR, LLNULL, LLNULL,
|
|
|
|
|
SMNULL);
|
|
|
|
|
p->entry.string_val = copys(stmtbuf);
|
|
|
|
|
$$ = get_bfnd(fi,DATA_DECL, SMNULL, p, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
data1: DATA inside data_in datapair
|
|
|
|
|
|
|
|
|
|
| data1 opt_comma datapair
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
data_in:
|
|
|
|
|
{data_stat = YES;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
in_data:
|
|
|
|
|
{
|
|
|
|
|
if (parstate == OUTSIDE)
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR,
|
|
|
|
|
make_program(look_up_sym("_MAIN")),
|
|
|
|
|
LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
/*parstate = INDCL;*/
|
|
|
|
|
}
|
|
|
|
|
if(parstate < INDCL)
|
|
|
|
|
{
|
|
|
|
|
/* enddcl();*/
|
|
|
|
|
parstate = INDCL;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datapair: datalvals SLASH datarvals SLASH
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datalvals: datalval
|
|
|
|
|
|
|
|
|
|
| datalvals COMMA datalval
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datarvals: datarval
|
|
|
|
|
| datarvals COMMA datarval
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datalval: data_null dataname
|
|
|
|
|
|
|
|
|
|
| data_null dataname datasubs
|
|
|
|
|
|
|
|
|
|
| data_null dataname datarange
|
|
|
|
|
|
|
|
|
|
| data_null dataname datasubs datarange
|
|
|
|
|
|
|
|
|
|
| data_null dataimplieddo
|
|
|
|
|
;
|
|
|
|
|
data_null:
|
|
|
|
|
{;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
d_name: name
|
|
|
|
|
{ $$= make_scalar($1, TYNULL, LOCAL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dataname: name
|
|
|
|
|
{ $$= make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
$$->attr = $$->attr | DATA_BIT;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datasubs: LEFTPAR iconexprlist RIGHTPAR
|
|
|
|
|
{ $$ = make_llnd(fi, DATA_SUBS, $2, LLNULL, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datarange: LEFTPAR opticonexpr COLON opticonexpr RIGHTPAR
|
|
|
|
|
{ $$ = make_llnd(fi, DATA_RANGE, $2, $4, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iconexprlist: iconexpr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| iconexprlist COMMA iconexpr
|
|
|
|
|
{ $$ = add_to_lowLevelList($3, $1); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opticonexpr:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| iconexpr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dataimplieddo: LEFTPAR dlist COMMA d_name EQUAL iconexprlist RIGHTPAR
|
|
|
|
|
{$$= make_llnd(fi, DATA_IMPL_DO, $2, $6, $4); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dlist: dataelt
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| dlist COMMA dataelt
|
|
|
|
|
{ $$ = add_to_lowLevelList($3, $1); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dataelt: dataname datasubs
|
|
|
|
|
{ $$ = make_llnd(fi, DATA_ELT, $2, LLNULL, $1); }
|
|
|
|
|
| dataname datarange
|
|
|
|
|
{ $$ = make_llnd(fi, DATA_ELT, $2, LLNULL, $1); }
|
|
|
|
|
| dataname datasubs datarange
|
|
|
|
|
{
|
|
|
|
|
$2->entry.Template.ll_ptr2 = $3;
|
|
|
|
|
$$ = make_llnd(fi, DATA_ELT, $2, LLNULL, $1);
|
|
|
|
|
}
|
|
|
|
|
| dataimplieddo
|
|
|
|
|
{ $$ = make_llnd(fi, DATA_ELT, $1, LLNULL, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datarval: datavalue
|
|
|
|
|
|
|
|
|
|
| data_null d_name ASTER datavalue
|
|
|
|
|
|
|
|
|
|
| unsignedint ASTER datavalue
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
datavalue: data_null d_name
|
|
|
|
|
|
|
|
|
|
| int_const
|
|
|
|
|
| real_const
|
|
|
|
|
| complex_const_data
|
|
|
|
|
| TTRUE
|
|
|
|
|
| TTRUE UNDER kind
|
|
|
|
|
| FFALSE
|
|
|
|
|
| FFALSE UNDER kind
|
|
|
|
|
| CHAR_CONSTANT
|
|
|
|
|
/* | STRING */
|
|
|
|
|
/* | bit_const */
|
|
|
|
|
| BOZ_const
|
|
|
|
|
| data_null ident LEFTPAR in_ioctl funarglist RIGHTPAR
|
|
|
|
|
{if($2->entry.Template.symbol->variant != TYPE_NAME)
|
|
|
|
|
errstr("Undefined type %s",$2->entry.Template.symbol->ident,319);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
BOZ_const: BOZ_CONSTANT
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
int_const: unsignedint
|
|
|
|
|
| PLUS unsignedint
|
|
|
|
|
|
|
|
|
|
| MINUS unsignedint
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
unsignedint: INT_CONSTANT
|
|
|
|
|
| INT_CONSTANT UNDER kind
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
real_const: unsignedreal
|
|
|
|
|
| PLUS unsignedreal
|
|
|
|
|
|
|
|
|
|
| MINUS unsignedreal
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
unsignedreal: REAL_CONSTANT
|
|
|
|
|
| REAL_CONSTANT UNDER kind
|
|
|
|
|
| DP_CONSTANT
|
|
|
|
|
| DP_CONSTANT UNDER kind
|
|
|
|
|
;
|
|
|
|
|
complex_const_data: LEFTPAR complex_part COMMA complex_part RIGHTPAR
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
complex_part: real_const
|
|
|
|
|
| int_const
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
bit_const:HEX_CONSTANT { $$ = mkbitcon(4, yyleng, yytext); }
|
|
|
|
|
| OCT_CONSTANT { $$ = mkbitcon(3, yyleng, yytext); }
|
|
|
|
|
| BITCON { $$ = mkbitcon(1, yyleng, yytext); }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
iconexpr: iconterm
|
|
|
|
|
{ $$ = make_llnd(fi,ICON_EXPR, $1, LLNULL, SMNULL); }
|
|
|
|
|
| PLUS iconterm
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = intrinsic_op_node("+", UNARY_ADD_OP, $2, LLNULL);
|
|
|
|
|
$$ = make_llnd(fi,ICON_EXPR, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| MINUS iconterm
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = intrinsic_op_node("-", MINUS_OP, $2, LLNULL);
|
|
|
|
|
$$ = make_llnd(fi,ICON_EXPR, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| iconexpr PLUS iconterm
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = intrinsic_op_node("+", ADD_OP, $1, $3);
|
|
|
|
|
$$ = make_llnd(fi,ICON_EXPR, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| iconexpr MINUS iconterm
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = intrinsic_op_node("-", SUBT_OP, $1, $3);
|
|
|
|
|
$$ = make_llnd(fi,ICON_EXPR, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iconterm: iconfactor
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| iconterm ASTER iconfactor
|
|
|
|
|
{ $$ = intrinsic_op_node("*", MULT_OP, $1, $3); }
|
|
|
|
|
| iconterm SLASH iconfactor
|
|
|
|
|
{ $$ = intrinsic_op_node("/", DIV_OP, $1, $3); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iconfactor: iconprimary
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| iconprimary DASTER iconfactor
|
|
|
|
|
{ $$ = intrinsic_op_node("**", EXP_OP, $1, $3); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iconprimary: INT_CONSTANT
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,INT_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.ival = atoi(yytext);
|
|
|
|
|
p->type = global_int;
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| d_name
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,VAR_REF, LLNULL, LLNULL, $1);
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| LEFTPAR iconexpr RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, $2, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
savelist: saveitem
|
|
|
|
|
{ $$ = make_llnd(fi,EXPR_LIST, $1, LLNULL, SMNULL); }
|
|
|
|
|
| savelist COMMA saveitem
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
saveitem: var
|
|
|
|
|
{ $$ = $1;
|
|
|
|
|
$$->entry.Template.symbol->attr = $$->entry.Template.symbol->attr | SAVE_BIT;
|
|
|
|
|
}
|
|
|
|
|
| comblock
|
|
|
|
|
{ $$ = make_llnd(fi,COMM_LIST, LLNULL, LLNULL, $1);
|
|
|
|
|
$$->entry.Template.symbol->attr = $$->entry.Template.symbol->attr | SAVE_BIT;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
use_name_list: use_key_word use_name no_use_key_word
|
|
|
|
|
{ $$ = set_ll_list($2, LLNULL, EXPR_LIST); }
|
|
|
|
|
| use_name_list COMMA use_key_word use_name no_use_key_word
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
use_key_word:
|
|
|
|
|
{ as_op_kwd_ = YES; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
no_use_key_word:
|
|
|
|
|
{ as_op_kwd_ = NO; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
use_name: name
|
|
|
|
|
{
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
s = make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
| OPERATOR LEFTPAR operator RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = make_function($3, global_default, LOCAL);
|
|
|
|
|
s->variant = INTERFACE_NAME;
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
$$ = make_llnd(fi,OPERATOR_OP, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
| ASSIGNMENT LEFTPAR EQUAL RIGHTPAR
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = make_procedure(look_up_sym("="), LOCAL);
|
|
|
|
|
s->variant = INTERFACE_NAME;
|
|
|
|
|
s->attr = s->attr | type_opt;
|
|
|
|
|
$$ = make_llnd(fi,ASSIGNMENT_OP, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
paramlist:paramitem
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| paramlist COMMA paramitem
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
paramitem: name EQUAL expr
|
|
|
|
|
{ PTR_SYMB p;
|
|
|
|
|
|
|
|
|
|
/* The check if name and expr have compatible types has
|
|
|
|
|
not been done yet. */
|
|
|
|
|
p = make_constant($1, TYNULL);
|
|
|
|
|
p->attr = p->attr | PARAMETER_BIT;
|
|
|
|
|
p->entry.const_value = $3;
|
|
|
|
|
$$ = make_llnd(fi,CONST_REF, LLNULL, LLNULL, p);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
module_proc_stmt: MODULE_PROCEDURE proc_name_list
|
|
|
|
|
{ $$ = get_bfnd(fi, MODULE_PROC_STMT, SMNULL, $2, LLNULL, LLNULL); }
|
|
|
|
|
|
|
|
|
|
proc_name_list: name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
|
|
|
|
|
s = make_function($1, TYNULL, LOCAL);
|
|
|
|
|
s->variant = ROUTINE_NAME;
|
|
|
|
|
q = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| proc_name_list COMMA name
|
|
|
|
|
{ PTR_LLND p, q;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
|
|
|
|
|
s = make_function($3, TYNULL, LOCAL);
|
|
|
|
|
s->variant = ROUTINE_NAME;
|
|
|
|
|
p = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
q = make_llnd(fi,EXPR_LIST, p, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(q, $1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
use_stat: USE in_dcl module_name
|
|
|
|
|
{ $$ = get_bfnd(fi, USE_STMT, $3, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
/*add_scope_level($3->entry.Template.func_hedr, YES);*/ /*17.06.01*/
|
|
|
|
|
copy_module_scope($3,LLNULL); /*17.03.03*/
|
|
|
|
|
colon_flag = NO;
|
|
|
|
|
}
|
|
|
|
|
| USE in_dcl module_name COMMA keyword_if_colon_follow rename_list
|
|
|
|
|
{ $$ = get_bfnd(fi, USE_STMT, $3, $6, LLNULL, LLNULL);
|
|
|
|
|
/*add_scope_level(module_scope, YES); *//* 17.06.01*/
|
|
|
|
|
copy_module_scope($3,$6); /*17.03.03 */
|
|
|
|
|
colon_flag = NO;
|
|
|
|
|
}
|
|
|
|
|
| USE in_dcl module_name COMMA keyword_if_colon_follow ONLY
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
l = make_llnd(fi, ONLY_NODE, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, USE_STMT, $3, l, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| USE in_dcl module_name COMMA keyword_if_colon_follow ONLY only_list
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
l = make_llnd(fi, ONLY_NODE, $7, LLNULL, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, USE_STMT, $3, l, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
module_name: name
|
|
|
|
|
{
|
|
|
|
|
if ($1->id_attr == SMNULL)
|
|
|
|
|
warn1("Unknown module %s", $1->ident,308);
|
|
|
|
|
$$ = make_global_entity($1, MODULE_NAME, global_default, NO);
|
|
|
|
|
module_scope = $$->entry.Template.func_hedr;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
only_list: only_name
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| only_list COMMA only_name
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
only_name: rename_name
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| name
|
|
|
|
|
{ PTR_HASH oldhash,copyhash;
|
|
|
|
|
PTR_SYMB oldsym, newsym;
|
|
|
|
|
PTR_LLND m;
|
|
|
|
|
|
|
|
|
|
oldhash = just_look_up_sym_in_scope(module_scope, $1->ident);
|
|
|
|
|
if (oldhash == HSNULL) {
|
|
|
|
|
errstr("Unknown identifier %s.", $1->ident,309);
|
|
|
|
|
$$= LLNULL;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
oldsym = oldhash->id_attr;
|
|
|
|
|
copyhash=just_look_up_sym_in_scope(cur_scope(), $1->ident);
|
|
|
|
|
if( copyhash && copyhash->id_attr && copyhash->id_attr->entry.Template.tag==module_scope->id)
|
|
|
|
|
{
|
|
|
|
|
newsym = copyhash->id_attr;
|
|
|
|
|
newsym->entry.Template.tag = 0;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
newsym = make_local_entity($1, oldsym->variant, oldsym->type,LOCAL);
|
|
|
|
|
/* copies data in entry.Template structure and attr */
|
|
|
|
|
copy_sym_data(oldsym, newsym);
|
|
|
|
|
/*newsym->entry.Template.base_name = oldsym;*//*19.03.03*/
|
|
|
|
|
}
|
|
|
|
|
/* l = make_llnd(fi, VAR_REF, LLNULL, LLNULL, oldsym);*/
|
|
|
|
|
m = make_llnd(fi, VAR_REF, LLNULL, LLNULL, newsym);
|
|
|
|
|
$$ = make_llnd(fi, RENAME_NODE, m, LLNULL, oldsym);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
rename_list: rename_name
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| rename_list COMMA rename_name
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
rename_name: name POINT_TO name
|
|
|
|
|
{ PTR_HASH oldhash,copyhash;
|
|
|
|
|
PTR_SYMB oldsym, newsym;
|
|
|
|
|
PTR_LLND l, m;
|
|
|
|
|
|
|
|
|
|
oldhash = just_look_up_sym_in_scope(module_scope, $3->ident);
|
|
|
|
|
if (oldhash == HSNULL) {
|
|
|
|
|
errstr("Unknown identifier %s", $3->ident,309);
|
|
|
|
|
$$= LLNULL;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
oldsym = oldhash->id_attr;
|
|
|
|
|
copyhash = just_look_up_sym_in_scope(cur_scope(), $3->ident);
|
|
|
|
|
if(copyhash && copyhash->id_attr && copyhash->id_attr->entry.Template.tag==module_scope->id)
|
|
|
|
|
{
|
|
|
|
|
delete_symbol(copyhash->id_attr);
|
|
|
|
|
copyhash->id_attr = SMNULL;
|
|
|
|
|
}
|
|
|
|
|
newsym = make_local_entity($1, oldsym->variant, oldsym->type, LOCAL);
|
|
|
|
|
/* copies data in entry.Template structure and attr */
|
|
|
|
|
copy_sym_data(oldsym, newsym);
|
|
|
|
|
|
|
|
|
|
/*newsym->entry.Template.base_name = oldsym;*//*19.03.03*/
|
|
|
|
|
l = make_llnd(fi, VAR_REF, LLNULL, LLNULL, oldsym);
|
|
|
|
|
m = make_llnd(fi, VAR_REF, LLNULL, LLNULL, newsym);
|
|
|
|
|
$$ = make_llnd(fi, RENAME_NODE, m, l, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
in_param: inside
|
|
|
|
|
{
|
|
|
|
|
if(parstate > INDCL)
|
|
|
|
|
dclerr("parameter statement out of order", SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
dims:
|
|
|
|
|
{ ndim = 0; explicit_shape = 1; $$ = LLNULL; }
|
|
|
|
|
| LEFTPAR dimlist RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dimlist: { ndim = 0; explicit_shape = 1;} dim
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,EXPR_LIST, $2, LLNULL, SMNULL);
|
|
|
|
|
$$->type = global_default;
|
|
|
|
|
}
|
|
|
|
|
| dimlist COMMA dim
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dim: ubound
|
|
|
|
|
{
|
|
|
|
|
if(ndim == maxdim)
|
|
|
|
|
err("Too many dimensions", 43);
|
|
|
|
|
else if(ndim < maxdim)
|
|
|
|
|
$$ = $1;
|
|
|
|
|
++ndim;
|
|
|
|
|
}
|
|
|
|
|
| COLON
|
|
|
|
|
{
|
|
|
|
|
if(ndim == maxdim)
|
|
|
|
|
err("Too many dimensions", 43);
|
|
|
|
|
else if(ndim < maxdim)
|
|
|
|
|
$$ = make_llnd(fi, DDOT, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
++ndim;
|
|
|
|
|
explicit_shape = 0;
|
|
|
|
|
}
|
|
|
|
|
| expr COLON
|
|
|
|
|
{
|
|
|
|
|
if(ndim == maxdim)
|
|
|
|
|
err("Too many dimensions", 43);
|
|
|
|
|
else if(ndim < maxdim)
|
|
|
|
|
$$ = make_llnd(fi,DDOT, $1, LLNULL, SMNULL);
|
|
|
|
|
++ndim;
|
|
|
|
|
explicit_shape = 0;
|
|
|
|
|
}
|
|
|
|
|
| expr COLON ubound
|
|
|
|
|
{
|
|
|
|
|
if(ndim == maxdim)
|
|
|
|
|
err("Too many dimensions", 43);
|
|
|
|
|
else if(ndim < maxdim)
|
|
|
|
|
$$ = make_llnd(fi,DDOT, $1, $3, SMNULL);
|
|
|
|
|
++ndim;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
ubound: ASTER
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,STAR_RANGE, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->type = global_default;
|
|
|
|
|
explicit_shape = 0;
|
|
|
|
|
}
|
|
|
|
|
| expr
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
labellist: label
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| labellist COMMA label
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
label: INT_CONSTANT
|
|
|
|
|
{PTR_LABEL p;
|
|
|
|
|
p = make_label_node(fi,convci(yyleng, yytext));
|
|
|
|
|
p->scope = cur_scope();
|
|
|
|
|
$$ = make_llnd_label(fi,LABEL_REF, p);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
implicit: IMPLICIT in_dcl implist
|
|
|
|
|
{ /*PTR_LLND l;*/
|
|
|
|
|
|
|
|
|
|
/* l = make_llnd(fi, EXPR_LIST, $3, LLNULL, SMNULL);*/
|
|
|
|
|
$$ = get_bfnd(fi,IMPL_DECL, SMNULL, $3, LLNULL, LLNULL);
|
|
|
|
|
redefine_func_arg_type();
|
|
|
|
|
}
|
|
|
|
|
/*
|
|
|
|
|
| implicit COMMA implist
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
l = make_llnd(fi, EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(l, $1->entry.Template.ll_ptr1);
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
| IMPLICITNONE
|
|
|
|
|
{ /*undeftype = YES;
|
|
|
|
|
setimpl(TYNULL, (int)'a', (int)'z'); FB COMMENTED---> NOT QUITE RIGHT BUT AVOID PB WITH COMMON*/
|
|
|
|
|
$$ = get_bfnd(fi,IMPL_DECL, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
implist: impitem
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| implist COMMA impitem
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
impitem: imptype LEFTPAR letgroups RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
|
|
|
|
|
$$ = make_llnd(fi, IMPL_TYPE, $3, LLNULL, SMNULL);
|
|
|
|
|
$$->type = vartype;
|
|
|
|
|
}
|
|
|
|
|
/* | imptype
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi, IMPL_TYPE, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->type = vartype;
|
|
|
|
|
}
|
|
|
|
|
*/ /*30.10.03*/
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/* The draft specification leads to big trouble. Check that up. */
|
|
|
|
|
/* For the time being. */
|
|
|
|
|
imptype: { implkwd = YES; } type_implicit
|
|
|
|
|
{ vartype = $2; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
type_implicit: STAT typename
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
| type
|
|
|
|
|
{ $$ = $1;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/* Not used.
|
|
|
|
|
in_implicit: inside
|
|
|
|
|
{
|
|
|
|
|
if (parstate >= INDCL)
|
|
|
|
|
dclerr("implicit statement out of order", SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
letgroups: letgroup
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| letgroups COMMA letgroup
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
letgroup: letter
|
|
|
|
|
{
|
|
|
|
|
setimpl(vartype, (int)$1, (int)$1);
|
|
|
|
|
$$ = make_llnd(fi,CHAR_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.cval = $1;
|
|
|
|
|
}
|
|
|
|
|
| letter MINUS letter
|
|
|
|
|
{ PTR_LLND p,q;
|
|
|
|
|
|
|
|
|
|
setimpl(vartype, (int)$1, (int)$3);
|
|
|
|
|
p = make_llnd(fi,CHAR_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.cval = $1;
|
|
|
|
|
q = make_llnd(fi,CHAR_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.cval = $3;
|
|
|
|
|
$$= make_llnd(fi,DDOT, p, q, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
letter: IDENTIFIER
|
|
|
|
|
{
|
|
|
|
|
if(yyleng!=1 || yytext[0]<'a' || yytext[0]>'z')
|
|
|
|
|
{
|
|
|
|
|
err("IMPLICIT item must be single letter", 37);
|
|
|
|
|
$$ = '\0';
|
|
|
|
|
}
|
|
|
|
|
else $$ = yytext[0];
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
inside:
|
|
|
|
|
{
|
|
|
|
|
if (parstate == OUTSIDE)
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR,
|
|
|
|
|
make_program(look_up_sym("_MAIN")),
|
|
|
|
|
LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
parstate = INSIDE;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
in_dcl:
|
|
|
|
|
{ switch(parstate)
|
|
|
|
|
{
|
|
|
|
|
case OUTSIDE:
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR,
|
|
|
|
|
make_program(look_up_sym("_MAIN")),
|
|
|
|
|
LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
parstate = INDCL; }
|
|
|
|
|
break;
|
|
|
|
|
case INSIDE: parstate = INDCL;
|
|
|
|
|
case INDCL: break;
|
|
|
|
|
|
|
|
|
|
case INDATA:
|
|
|
|
|
/* err(
|
|
|
|
|
"Statement order error: declaration after DATA or function statement",
|
|
|
|
|
29);*/
|
|
|
|
|
break;
|
|
|
|
|
|
|
|
|
|
default:
|
|
|
|
|
err("Declaration among executables", 30);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_double_colon:
|
|
|
|
|
| COLON COLON
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* Grammar for expressions
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
funarglist:
|
|
|
|
|
{ $$ = LLNULL; endioctl(); }
|
|
|
|
|
| funargs
|
|
|
|
|
{ $$ = $1; endioctl();}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
funarg: expr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| triplet
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| nameeq expr
|
|
|
|
|
{ PTR_LLND l;
|
|
|
|
|
l = make_llnd(fi, KEYWORD_ARG, $1, $2, SMNULL);
|
|
|
|
|
l->type = $2->type;
|
|
|
|
|
$$ = l;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
funargs: in_ioctl funarg
|
|
|
|
|
{ $$ = set_ll_list($2, LLNULL, EXPR_LIST);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| funargs COMMA in_ioctl funarg
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
subscript_list: expr
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| subscript_list COMMA expr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
expr: uexpr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
| complex_const
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
uexpr: lhs
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| simple_const
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
/* | string_constant opt_substring
|
|
|
|
|
{ $$ = make_llnd(fi, ARRAY_OP, $1, $2, SMNULL); }
|
|
|
|
|
*/ | vec
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| expr PLUS expr %prec PLUS
|
|
|
|
|
{ $$ = intrinsic_op_node("+", ADD_OP, $1, $3); }
|
|
|
|
|
| expr MINUS expr %prec PLUS
|
|
|
|
|
{ $$ = intrinsic_op_node("-", SUBT_OP, $1, $3); }
|
|
|
|
|
| expr ASTER expr
|
|
|
|
|
{ $$ = intrinsic_op_node("*", MULT_OP, $1, $3); }
|
|
|
|
|
| expr SLASH expr
|
|
|
|
|
{ $$ = intrinsic_op_node("/", DIV_OP, $1, $3); }
|
|
|
|
|
| expr DASTER expr
|
|
|
|
|
{ $$ = intrinsic_op_node("**", EXP_OP, $1, $3); }
|
|
|
|
|
| defined_op expr %prec UNARY_OP
|
|
|
|
|
{ $$ = defined_op_node($1, $2, LLNULL); }
|
|
|
|
|
| PLUS expr %prec ASTER
|
|
|
|
|
{ $$ = intrinsic_op_node("+", UNARY_ADD_OP, $2, LLNULL); }
|
|
|
|
|
| MINUS expr %prec ASTER
|
|
|
|
|
{ $$ = intrinsic_op_node("-", MINUS_OP, $2, LLNULL); }
|
|
|
|
|
| expr EQ expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".eq.", EQ_OP, $1, $3); }
|
|
|
|
|
| expr GT expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".gt.", GT_OP, $1, $3); }
|
|
|
|
|
| expr LT expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".lt.", LT_OP, $1, $3); }
|
|
|
|
|
| expr GE expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".ge.", GTEQL_OP, $1, $3); }
|
|
|
|
|
| expr LE expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".ge.", LTEQL_OP, $1, $3); }
|
|
|
|
|
| expr NE expr %prec EQ
|
|
|
|
|
{ $$ = intrinsic_op_node(".ne.", NOTEQL_OP, $1, $3); }
|
|
|
|
|
| expr EQV expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".eqv.", EQV_OP, $1, $3); }
|
|
|
|
|
| expr NEQV expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".neqv.", NEQV_OP, $1, $3); }
|
|
|
|
|
| expr XOR expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".xor.", XOR_OP, $1, $3); }
|
|
|
|
|
| expr OR expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".or.", OR_OP, $1, $3); }
|
|
|
|
|
| expr AND expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".and.", AND_OP, $1, $3); }
|
|
|
|
|
| NOT expr
|
|
|
|
|
{ $$ = intrinsic_op_node(".not.", NOT_OP, $2, LLNULL); }
|
|
|
|
|
| expr DSLASH expr
|
|
|
|
|
{ $$ = intrinsic_op_node("//", CONCAT_OP, $1, $3); }
|
|
|
|
|
| expr defined_op expr %prec BINARY_OP
|
|
|
|
|
{ $$ = defined_op_node($2, $1, $3); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
addop: PLUS { $$ = ADD_OP; }
|
|
|
|
|
| MINUS { $$ = SUBT_OP; }
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
relop: EQ { $$ = EQ_OP; }
|
|
|
|
|
| GT { $$ = GT_OP; }
|
|
|
|
|
| LT { $$ = LT_OP; }
|
|
|
|
|
| GE { $$ = GTEQL_OP; }
|
|
|
|
|
| LE { $$ = LTEQL_OP; }
|
|
|
|
|
| NE { $$ = NOTEQL_OP; }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
ident: name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_TYPE t;
|
|
|
|
|
/* PTR_LLND l;*/
|
|
|
|
|
|
|
|
|
|
if (!(s = $1->id_attr))
|
|
|
|
|
{
|
|
|
|
|
s = make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
s->decl = SOFT;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
switch (s->variant)
|
|
|
|
|
{
|
|
|
|
|
case CONST_NAME:
|
|
|
|
|
$$ = make_llnd(fi,CONST_REF,LLNULL,LLNULL, s);
|
|
|
|
|
t = s->type;
|
|
|
|
|
if ((t != TYNULL) &&
|
|
|
|
|
((t->variant == T_ARRAY) || (t->variant == T_STRING) ))
|
|
|
|
|
$$->variant = ARRAY_REF;
|
|
|
|
|
|
|
|
|
|
$$->type = t;
|
|
|
|
|
break;
|
|
|
|
|
case DEFAULT: /* if common region with same name has been
|
|
|
|
|
declared. */
|
|
|
|
|
s = make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
s->decl = SOFT;
|
|
|
|
|
|
|
|
|
|
case VARIABLE_NAME:
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF,LLNULL,LLNULL, s);
|
|
|
|
|
t = s->type;
|
|
|
|
|
if (t != TYNULL) {
|
|
|
|
|
if ((t->variant == T_ARRAY) || (t->variant == T_STRING) ||
|
|
|
|
|
((t->variant == T_POINTER) && (t->entry.Template.base_type->variant == T_ARRAY) ) )
|
|
|
|
|
$$->variant = ARRAY_REF;
|
|
|
|
|
|
|
|
|
|
/* if (t->variant == T_DERIVED_TYPE)
|
|
|
|
|
$$->variant = RECORD_REF; */
|
|
|
|
|
}
|
|
|
|
|
$$->type = t;
|
|
|
|
|
break;
|
|
|
|
|
case TYPE_NAME:
|
|
|
|
|
$$ = make_llnd(fi,TYPE_REF,LLNULL,LLNULL, s);
|
|
|
|
|
$$->type = s->type;
|
|
|
|
|
break;
|
|
|
|
|
case INTERFACE_NAME:
|
|
|
|
|
$$ = make_llnd(fi, INTERFACE_REF,LLNULL,LLNULL, s);
|
|
|
|
|
$$->type = s->type;
|
|
|
|
|
break;
|
|
|
|
|
case FUNCTION_NAME:
|
|
|
|
|
if(isResultVar(s)) {
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF,LLNULL,LLNULL, s);
|
|
|
|
|
t = s->type;
|
|
|
|
|
if (t != TYNULL) {
|
|
|
|
|
if ((t->variant == T_ARRAY) || (t->variant == T_STRING) ||
|
|
|
|
|
((t->variant == T_POINTER) && (t->entry.Template.base_type->variant == T_ARRAY) ) )
|
|
|
|
|
$$->variant = ARRAY_REF;
|
|
|
|
|
}
|
|
|
|
|
$$->type = t;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
default:
|
|
|
|
|
$$ = make_llnd(fi,VAR_REF,LLNULL,LLNULL, s);
|
|
|
|
|
$$->type = s->type;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
/* if ($$->variant == T_POINTER) {
|
|
|
|
|
l = $$;
|
|
|
|
|
$$ = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$$->type = l->type->entry.Template.base_type;
|
|
|
|
|
}
|
|
|
|
|
*/ /*11.02.03*/
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
lhs: ident
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
s= $$->entry.Template.symbol;
|
|
|
|
|
if ((($1->variant == VAR_REF) || ($1->variant == ARRAY_REF)) && (s->scope !=cur_scope())) /*global_bfnd*/
|
|
|
|
|
{
|
|
|
|
|
if(((s->variant == FUNCTION_NAME) && (!isResultVar(s))) || (s->variant == PROCEDURE_NAME) || (s->variant == ROUTINE_NAME))
|
|
|
|
|
{ s = $$->entry.Template.symbol = make_scalar(s->parent, TYNULL, LOCAL);
|
|
|
|
|
$$->type = s->type;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| structure_component
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| array_ele_substring_func_ref
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
array_ele_substring_func_ref: ident LEFTPAR in_ioctl funarglist RIGHTPAR
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_SYMB s; /*, sym;*/
|
|
|
|
|
/* PTR_LLND l; */
|
|
|
|
|
PTR_TYPE tp;
|
|
|
|
|
/* l = $1; */
|
|
|
|
|
s = $1->entry.Template.symbol;
|
|
|
|
|
|
|
|
|
|
/* Handle variable to function conversion. */
|
|
|
|
|
if (($1->variant == VAR_REF) &&
|
|
|
|
|
(((s->variant == VARIABLE_NAME) && (s->type) &&
|
|
|
|
|
(s->type->variant != T_ARRAY)) ||
|
|
|
|
|
(s->variant == ROUTINE_NAME))) {
|
|
|
|
|
s = $1->entry.Template.symbol = make_function(s->parent, TYNULL, LOCAL);
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
}
|
|
|
|
|
if (($1->variant == VAR_REF) && (s->variant == FUNCTION_NAME)) {
|
|
|
|
|
if(isResultVar(s))
|
|
|
|
|
$1->variant = ARRAY_REF;
|
|
|
|
|
else
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
}
|
|
|
|
|
if (($1->variant == VAR_REF) && (s->variant == PROGRAM_NAME)) {
|
|
|
|
|
errstr("The name '%s' is invalid in this context",s->ident,285);
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
}
|
|
|
|
|
/* l = $1; */
|
|
|
|
|
num_triplets = is_array_section_ref($4);
|
|
|
|
|
switch ($1->variant)
|
|
|
|
|
{
|
|
|
|
|
case TYPE_REF:
|
|
|
|
|
$1->variant = STRUCTURE_CONSTRUCTOR;
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
$$->type = lookup_type(s->parent);
|
|
|
|
|
/* $$ = make_llnd(fi, STRUCTURE_CONSTRUCTOR, $1, $4, SMNULL);
|
|
|
|
|
$$->type = $1->type;*//*18.02.03*/
|
|
|
|
|
break;
|
|
|
|
|
case INTERFACE_REF:
|
|
|
|
|
/* sym = resolve_overloading(s, $4);
|
|
|
|
|
if (sym != SMNULL)
|
|
|
|
|
{
|
|
|
|
|
l = make_llnd(fi, FUNC_CALL, $4, LLNULL, sym);
|
|
|
|
|
l->type = sym->type;
|
|
|
|
|
$$ = $1; $$->variant = OVERLOADED_CALL;
|
|
|
|
|
$$->entry.Template.ll_ptr1 = l;
|
|
|
|
|
$$->type = sym->type;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
errstr("can't resolve call %s", s->ident,310);
|
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
*/ /*podd 01.02.03*/
|
|
|
|
|
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
|
|
|
|
|
case FUNC_CALL:
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
if(s->type)
|
|
|
|
|
$$->type = s->type;
|
|
|
|
|
else
|
|
|
|
|
$$->type = global_default;
|
|
|
|
|
/*late_bind_if_needed($$);*/ /*podd 02.02.23*/
|
|
|
|
|
break;
|
|
|
|
|
case DEREF_OP:
|
|
|
|
|
case ARRAY_REF:
|
|
|
|
|
/* array element */
|
|
|
|
|
if (num_triplets == 0) {
|
|
|
|
|
if ($4 == LLNULL) {
|
|
|
|
|
s = $1->entry.Template.symbol = make_function(s->parent, TYNULL, LOCAL);
|
|
|
|
|
s->entry.func_decl.num_output = 1;
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
} else if ($1->type->variant == T_STRING) {
|
|
|
|
|
PTR_LLND temp = $4;
|
|
|
|
|
int num_input = 0;
|
|
|
|
|
|
|
|
|
|
while (temp) {
|
|
|
|
|
++num_input;
|
|
|
|
|
temp = temp->entry.Template.ll_ptr2;
|
|
|
|
|
}
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
s = $1->entry.Template.symbol = make_function(s->parent, TYNULL, LOCAL);
|
|
|
|
|
s->entry.func_decl.num_output = 1;
|
|
|
|
|
s->entry.func_decl.num_input = num_input;
|
|
|
|
|
$1->variant = FUNC_CALL;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
} else {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
$$->type = $1->type->entry.ar_decl.base_type;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
/* substring */
|
|
|
|
|
else if ((num_triplets == 1) &&
|
|
|
|
|
($1->type->variant == T_STRING)) {
|
|
|
|
|
/*
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; $$->type = global_string;
|
|
|
|
|
*/
|
|
|
|
|
$$ = make_llnd(fi,
|
|
|
|
|
ARRAY_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.Template.ll_ptr1 = $1;
|
|
|
|
|
$$->entry.Template.ll_ptr2 = $4->entry.Template.ll_ptr1;
|
|
|
|
|
$$->type = global_string;
|
|
|
|
|
}
|
|
|
|
|
/* array section */
|
|
|
|
|
else {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; tp = make_type(fi, T_ARRAY); /**18.03.17*/
|
|
|
|
|
tp->entry.ar_decl.base_type = $1->type->entry.ar_decl.base_type; /**18.03.17 $1->type */
|
|
|
|
|
tp->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
$$->type = tp;
|
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
default:
|
|
|
|
|
if($1->entry.Template.symbol)
|
|
|
|
|
errstr("Can't subscript %s",$1->entry.Template.symbol->ident, 44);
|
|
|
|
|
else
|
|
|
|
|
err("Can't subscript",44);
|
|
|
|
|
}
|
|
|
|
|
/*if ($$->variant == T_POINTER) {
|
|
|
|
|
l = $$;
|
|
|
|
|
$$ = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$$->type = l->type->entry.Template.base_type;
|
|
|
|
|
}
|
|
|
|
|
*/ /*11.02.03*/
|
|
|
|
|
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| ident LEFTPAR in_ioctl funarglist RIGHTPAR substring
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_SYMB s;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
s = $1->entry.Template.symbol;
|
|
|
|
|
/* if ($1->type->variant == T_POINTER) {
|
|
|
|
|
l = $1;
|
|
|
|
|
$1 = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$1->type = l->type->entry.Template.base_type;
|
|
|
|
|
} */
|
|
|
|
|
if (($1->type->variant != T_ARRAY) ||
|
|
|
|
|
($1->type->entry.ar_decl.base_type->variant != T_STRING)) {
|
|
|
|
|
errstr("Can't take substring of %s", s->ident, 45);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
num_triplets = is_array_section_ref($4);
|
|
|
|
|
/* array element */
|
|
|
|
|
if (num_triplets == 0) {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
/* $1->entry.Template.ll_ptr2 = $6;*/
|
|
|
|
|
/* $$ = $1;*/
|
|
|
|
|
l=$1;
|
|
|
|
|
/*$$->type = $1->type->entry.ar_decl.base_type;*/
|
|
|
|
|
l->type = global_string; /**18.03.17* $1->type->entry.ar_decl.base_type;*/
|
|
|
|
|
}
|
|
|
|
|
/* array section */
|
|
|
|
|
else {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
/*$1->entry.Template.ll_ptr2 = $6;
|
|
|
|
|
$$ = $1; $$->type = make_type(fi, T_ARRAY);
|
|
|
|
|
$$->type->entry.ar_decl.base_type = $1->type;
|
|
|
|
|
$$->type->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
*/
|
|
|
|
|
l = $1; l->type = make_type(fi, T_ARRAY);
|
|
|
|
|
l->type->entry.ar_decl.base_type = global_string; /**18.03.17* $1->type*/
|
|
|
|
|
l->type->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
}
|
|
|
|
|
$$ = make_llnd(fi, ARRAY_OP, l, $6, SMNULL);
|
|
|
|
|
$$->type = l->type;
|
|
|
|
|
|
|
|
|
|
/* if ($$->variant == T_POINTER) {
|
|
|
|
|
l = $$;
|
|
|
|
|
$$ = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$$->type = l->type->entry.Template.base_type;
|
|
|
|
|
}
|
|
|
|
|
*/ /*11.02.03*/
|
|
|
|
|
}
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| structure_component LEFTPAR funarglist RIGHTPAR
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_LLND l,l1,l2;
|
|
|
|
|
PTR_TYPE tp;
|
|
|
|
|
|
|
|
|
|
/* if ($1->variant == T_POINTER) {
|
|
|
|
|
l = $1;
|
|
|
|
|
$1 = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$1->type = l->type->entry.Template.base_type;
|
|
|
|
|
} */
|
|
|
|
|
|
|
|
|
|
num_triplets = is_array_section_ref($3);
|
|
|
|
|
$$ = $1;
|
|
|
|
|
l2 = $1->entry.Template.ll_ptr2;
|
|
|
|
|
l1 = $1->entry.Template.ll_ptr1;
|
|
|
|
|
if(l2 && l2->type->variant == T_STRING)/*substring*/
|
|
|
|
|
if(num_triplets == 1){
|
|
|
|
|
l = make_llnd(fi, ARRAY_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->entry.Template.ll_ptr1 = l2;
|
|
|
|
|
l->entry.Template.ll_ptr2 = $3->entry.Template.ll_ptr1;
|
|
|
|
|
l->type = global_string;
|
|
|
|
|
$$->entry.Template.ll_ptr2 = l;
|
|
|
|
|
} else
|
|
|
|
|
err("Can't subscript",44);
|
|
|
|
|
else if (l2 && l2->type->variant == T_ARRAY) {
|
|
|
|
|
if(num_triplets > 0) { /*array section*/
|
|
|
|
|
tp = make_type(fi,T_ARRAY);
|
|
|
|
|
tp->entry.ar_decl.base_type = $1->type->entry.ar_decl.base_type;
|
|
|
|
|
tp->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
$$->type = tp;
|
|
|
|
|
l2->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
l2->type = $$->type;
|
|
|
|
|
}
|
|
|
|
|
else { /*array element*/
|
|
|
|
|
l2->type = l2->type->entry.ar_decl.base_type;
|
|
|
|
|
l2->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
if(l1->type->variant != T_ARRAY)
|
|
|
|
|
$$->type = l2->type;
|
|
|
|
|
}
|
|
|
|
|
} else
|
|
|
|
|
{err("Can't subscript",44); /*fprintf(stderr,"%d %d",$1->variant,l2);*/}
|
|
|
|
|
/*errstr("Can't subscript %s",l2->entry.Template.symbol->ident,441);*/
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| structure_component LEFTPAR funarglist RIGHTPAR substring
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_LLND l,q;
|
|
|
|
|
|
|
|
|
|
/* if ($1->variant == T_POINTER) {
|
|
|
|
|
l = $1;
|
|
|
|
|
$1 = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$1->type = l->type->entry.Template.base_type;
|
|
|
|
|
} */
|
|
|
|
|
|
|
|
|
|
$$ = $1;
|
|
|
|
|
if (($1->type->variant != T_ARRAY) &&
|
|
|
|
|
($1->type->entry.ar_decl.base_type->variant != T_STRING)) {
|
|
|
|
|
err("Can't take substring",45);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
num_triplets = is_array_section_ref($3);
|
|
|
|
|
l = $1->entry.Template.ll_ptr2;
|
|
|
|
|
if(l) {
|
|
|
|
|
/* array element */
|
|
|
|
|
if (num_triplets == 0) {
|
|
|
|
|
l->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
l->type = global_string;
|
|
|
|
|
}
|
|
|
|
|
/* array section */
|
|
|
|
|
else {
|
|
|
|
|
l->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
l->type = make_type(fi, T_ARRAY);
|
|
|
|
|
l->type->entry.ar_decl.base_type = global_string;
|
|
|
|
|
l->type->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
}
|
|
|
|
|
q = make_llnd(fi, ARRAY_OP, l, $5, SMNULL);
|
|
|
|
|
q->type = l->type;
|
|
|
|
|
$$->entry.Template.ll_ptr2 = q;
|
|
|
|
|
if($1->entry.Template.ll_ptr1->type->variant != T_ARRAY)
|
|
|
|
|
$$->type = q->type;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
structure_component: lhs PERCENT IDENTIFIER
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
PTR_SYMB field;
|
|
|
|
|
/* PTR_BFND at_scope;*/
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* if ($1->variant == T_POINTER) {
|
|
|
|
|
l = $1;
|
|
|
|
|
$1 = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$1->type = l->type->entry.Template.base_type;
|
|
|
|
|
} */
|
|
|
|
|
|
|
|
|
|
t = $1->type;
|
|
|
|
|
|
|
|
|
|
if (( ( ($1->variant == VAR_REF)
|
|
|
|
|
|| ($1->variant == CONST_REF)
|
|
|
|
|
|| ($1->variant == ARRAY_REF)
|
|
|
|
|
|| ($1->variant == RECORD_REF)) && (t->variant == T_DERIVED_TYPE))
|
|
|
|
|
||((($1->variant == ARRAY_REF) || ($1->variant == RECORD_REF)) && (t->variant == T_ARRAY) &&
|
|
|
|
|
(t = t->entry.ar_decl.base_type) && (t->variant == T_DERIVED_TYPE)))
|
|
|
|
|
{
|
|
|
|
|
t->name = lookup_type_symbol(t->name);
|
|
|
|
|
if ((field = component(t->name, yytext))) {
|
|
|
|
|
l = make_llnd(fi, VAR_REF, LLNULL, LLNULL, field);
|
|
|
|
|
l->type = field->type;
|
|
|
|
|
if(field->type->variant == T_ARRAY || field->type->variant == T_STRING)
|
|
|
|
|
l->variant = ARRAY_REF;
|
|
|
|
|
$$ = make_llnd(fi, RECORD_REF, $1, l, SMNULL);
|
|
|
|
|
if($1->type->variant != T_ARRAY)
|
|
|
|
|
$$->type = field->type;
|
|
|
|
|
else {
|
|
|
|
|
$$->type = make_type(fi,T_ARRAY);
|
|
|
|
|
if(field->type->variant != T_ARRAY)
|
|
|
|
|
$$->type->entry.ar_decl.base_type = field->type;
|
|
|
|
|
else
|
|
|
|
|
$$->type->entry.ar_decl.base_type = field->type->entry.ar_decl.base_type;
|
|
|
|
|
$$->type->entry.ar_decl.num_dimensions = t->entry.ar_decl.num_dimensions;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
errstr("Illegal component %s", yytext,311);
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
errstr("Can't take component %s", yytext,311);
|
|
|
|
|
}
|
|
|
|
|
/* if ($$->variant == T_POINTER) {
|
|
|
|
|
l = $$;
|
|
|
|
|
$$ = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$$->type = l->type->entry.Template.base_type;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else errstr("Can't take component of %s", yytext, 311);
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
array_element: ident
|
|
|
|
|
{ $$ = $1;}
|
|
|
|
|
| structure_component
|
|
|
|
|
{$$ = $1;}
|
|
|
|
|
| ident LEFTPAR in_ioctl funarglist RIGHTPAR
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_TYPE tp;
|
|
|
|
|
/* PTR_LLND l;*/
|
|
|
|
|
if ($1->type->variant == T_ARRAY)
|
|
|
|
|
{
|
|
|
|
|
num_triplets = is_array_section_ref($4);
|
|
|
|
|
/* array element */
|
|
|
|
|
if (num_triplets == 0) {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1;
|
|
|
|
|
$$->type = $1->type->entry.ar_decl.base_type;
|
|
|
|
|
}
|
|
|
|
|
/* substring */
|
|
|
|
|
/* else if ((num_triplets == 1) &&
|
|
|
|
|
($1->type->variant == T_STRING)) {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; $$->type = global_string;
|
|
|
|
|
} */ /*podd*/
|
|
|
|
|
/* array section */
|
|
|
|
|
else {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; tp = make_type(fi, T_ARRAY);
|
|
|
|
|
tp->entry.ar_decl.base_type = $1->type->entry.ar_decl.base_type; /**18.03.17* $1->type */
|
|
|
|
|
tp->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
$$->type = tp;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else err("can't subscript",44);
|
|
|
|
|
|
|
|
|
|
/* if ($$->variant == T_POINTER) {
|
|
|
|
|
l = $$;
|
|
|
|
|
$$ = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$$->type = l->type->entry.Template.base_type;
|
|
|
|
|
}
|
|
|
|
|
*/ /*11.02.03*/
|
|
|
|
|
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| structure_component LEFTPAR funarglist RIGHTPAR
|
|
|
|
|
|
|
|
|
|
{ int num_triplets;
|
|
|
|
|
PTR_LLND l,l1,l2;
|
|
|
|
|
|
|
|
|
|
/* if ($1->variant == T_POINTER) {
|
|
|
|
|
l = $1;
|
|
|
|
|
$1 = make_llnd(fi, DEREF_OP, l, LLNULL, SMNULL);
|
|
|
|
|
$1->type = l->type->entry.Template.base_type;
|
|
|
|
|
} */
|
|
|
|
|
|
|
|
|
|
num_triplets = is_array_section_ref($3);
|
|
|
|
|
$$ = $1;
|
|
|
|
|
l2 = $1->entry.Template.ll_ptr2;
|
|
|
|
|
l1 = $1->entry.Template.ll_ptr1;
|
|
|
|
|
if(l2 && l2->type->variant == T_STRING)/*substring*/
|
|
|
|
|
if(num_triplets == 1){
|
|
|
|
|
l = make_llnd(fi, ARRAY_OP, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
l->entry.Template.ll_ptr1 = l2;
|
|
|
|
|
l->entry.Template.ll_ptr2 = $3->entry.Template.ll_ptr1;
|
|
|
|
|
l->type = global_string;
|
|
|
|
|
$$->entry.Template.ll_ptr2 = l;
|
|
|
|
|
} else
|
|
|
|
|
err("Can't subscript",44);
|
|
|
|
|
else if (l2 && l2->type->variant == T_ARRAY) {
|
|
|
|
|
if(num_triplets > 0) { /*array section*/
|
|
|
|
|
$$->type = make_type(fi,T_ARRAY);
|
|
|
|
|
$$->type->entry.ar_decl.base_type = l2->type->entry.ar_decl.base_type;
|
|
|
|
|
$$->type->entry.ar_decl.num_dimensions = num_triplets;
|
|
|
|
|
l2->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
l2->type = $$->type;
|
|
|
|
|
}
|
|
|
|
|
else { /*array element*/
|
|
|
|
|
l2->type = l2->type->entry.ar_decl.base_type;
|
|
|
|
|
l2->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
if(l1->type->variant != T_ARRAY)
|
|
|
|
|
$$->type = l2->type;
|
|
|
|
|
}
|
|
|
|
|
} else
|
|
|
|
|
err("Can't subscript",44);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
asubstring: ident substring
|
|
|
|
|
{
|
|
|
|
|
if ($1->type->variant == T_STRING) {
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $2;
|
|
|
|
|
$$ = $1; $$->type = global_string;
|
|
|
|
|
}
|
|
|
|
|
else errstr("can't subscript of %s", $1->entry.Template.symbol->ident,44);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_substring:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| substring
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
substring: LEFTPAR opt_expr COLON opt_expr RIGHTPAR
|
|
|
|
|
{ $$ = make_llnd(fi, DDOT, $2, $4, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_expr:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| expr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
simple_const: numeric_bool_const
|
|
|
|
|
{ $$ = $1;}
|
|
|
|
|
| numeric_bool_const UNDER kind
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
t = make_type_node($1->type, $3);
|
|
|
|
|
$$ = $1;
|
|
|
|
|
$$->type = t;
|
|
|
|
|
}
|
|
|
|
|
| integer_constant
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| integer_constant UNDER kind
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
t = make_type_node($1->type, $3);
|
|
|
|
|
$$ = $1;
|
|
|
|
|
$$->type = t;
|
|
|
|
|
}
|
|
|
|
|
| string_constant opt_substring
|
|
|
|
|
{
|
|
|
|
|
if ($2 != LLNULL)
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi, ARRAY_OP, $1, $2, SMNULL);
|
|
|
|
|
$$->type = global_string;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
$$ = $1;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
numeric_bool_const:
|
|
|
|
|
TTRUE
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,BOOL_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.bval = 1;
|
|
|
|
|
$$->type = global_bool;
|
|
|
|
|
}
|
|
|
|
|
| FFALSE
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,BOOL_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.bval = 0;
|
|
|
|
|
$$->type = global_bool;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| REAL_CONSTANT
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,FLOAT_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
$$->type = global_float;
|
|
|
|
|
}
|
|
|
|
|
| DP_CONSTANT
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,DOUBLE_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
$$->type = global_double;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
integer_constant: INT_CONSTANT
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,INT_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.ival = atoi(yytext);
|
|
|
|
|
$$->type = global_int;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
string_constant: CHAR_CONSTANT
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
PTR_LLND p,q;
|
|
|
|
|
$$ = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
if(yyquote=='\"')
|
|
|
|
|
t = global_string_2;
|
|
|
|
|
else
|
|
|
|
|
t = global_string;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,INT_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.ival = yyleng;
|
|
|
|
|
p->type = global_int;
|
|
|
|
|
q = make_llnd(fi, LEN_OP, p, LLNULL, SMNULL);
|
|
|
|
|
$$->type = make_type_node(t, q);
|
|
|
|
|
}
|
|
|
|
|
| ident UNDER CHAR_CONSTANT
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
$$ = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
if(yyquote=='\"')
|
|
|
|
|
t = global_string_2;
|
|
|
|
|
else
|
|
|
|
|
t = global_string;
|
|
|
|
|
$$->type = make_type_node(t, $1);
|
|
|
|
|
}
|
|
|
|
|
| integer_constant UNDER CHAR_CONSTANT
|
|
|
|
|
{ PTR_TYPE t;
|
|
|
|
|
$$ = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
if(yyquote=='\"')
|
|
|
|
|
t = global_string_2;
|
|
|
|
|
else
|
|
|
|
|
t = global_string;
|
|
|
|
|
$$->type = make_type_node(t, $1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
complex_const: LEFTPAR uexpr COMMA uexpr RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,COMPLEX_VAL, $2, $4, SMNULL);
|
|
|
|
|
$$->type = global_complex;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
kind: ident
|
|
|
|
|
{ $$ = $1;}
|
|
|
|
|
| integer_constant
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
section: LEFTPAR triplets RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
triplets:triplet
|
|
|
|
|
{ $$ = make_llnd(fi,EXPR_LIST, $1, LLNULL, SMNULL); }
|
|
|
|
|
|
|
|
|
|
| triplets COMMA triplet
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }*/
|
|
|
|
|
/* I changed uexpr to expr in below rule and triplet rules.
|
|
|
|
|
Don't know why Daya wrote it as uexpr. Srinivas. */
|
|
|
|
|
/* | triplets COMMA expr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); } */
|
|
|
|
|
/* Deleted. Purpose unknown. Srinivas.
|
|
|
|
|
| expr COMMA triplets
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;*/
|
|
|
|
|
|
|
|
|
|
triplet: expr COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,$1,$3,SMNULL); }
|
|
|
|
|
| expr COLON
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,$1,LLNULL,SMNULL); }
|
|
|
|
|
| expr COLON expr COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,make_llnd(fi,DDOT,$1,$3,SMNULL),$5,SMNULL); }
|
|
|
|
|
| expr COLON COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,make_llnd(fi,DDOT,$1,LLNULL,SMNULL),$4,SMNULL); }
|
|
|
|
|
| COLON expr COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT, make_llnd(fi,DDOT,LLNULL,$2,SMNULL),$4,SMNULL); }
|
|
|
|
|
| COLON COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,make_llnd(fi,DDOT,LLNULL,LLNULL,SMNULL),$3,SMNULL); }
|
|
|
|
|
| COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,LLNULL,$2,SMNULL); }
|
|
|
|
|
| COLON
|
|
|
|
|
{ $$ = make_llnd(fi,DDOT,LLNULL,LLNULL,SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
vec: LEFTAB end_ioctl {in_vec=YES;} outlist {in_vec=NO;} RIGHTAB
|
|
|
|
|
{ PTR_TYPE array_type;
|
|
|
|
|
$$ = make_llnd (fi,CONSTRUCTOR_REF,$4,LLNULL,SMNULL);
|
|
|
|
|
/*$$->type = $2->type;*/ /*28.02.03*/
|
|
|
|
|
array_type = make_type(fi, T_ARRAY);
|
|
|
|
|
array_type->entry.ar_decl.num_dimensions = 1;
|
|
|
|
|
if($4->type->variant == T_ARRAY)
|
|
|
|
|
array_type->entry.ar_decl.base_type = $4->type->entry.ar_decl.base_type;
|
|
|
|
|
else
|
|
|
|
|
array_type->entry.ar_decl.base_type = $4->type;
|
|
|
|
|
$$->type = array_type;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
allocate_object: ident
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| structure_component
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
allocation_list: ident
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| structure_component
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
|
|
|
|
|
allocation_list: allocate_object
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*allocation_list: array_element
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| allocation_list COMMA opt_key_word array_element
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); opt_kwd_ = NO; }
|
|
|
|
|
| allocation_list COMMA opt_key_word STAT EQUAL ident
|
|
|
|
|
{ stat_alloc = $6; }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
allocation_list: array_element
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| allocation_list COMMA in_ioctl array_element
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); endioctl(); }
|
|
|
|
|
| allocation_list COMMA in_ioctl nameeq ident
|
|
|
|
|
{ stat_alloc = make_llnd(fi, SPEC_PAIR, $4, $5, SMNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*allocate_object_list: allocate_object
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| allocate_object_list COMMA opt_key_word allocate_object
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); opt_kwd_ = NO; }
|
|
|
|
|
| allocate_object_list COMMA opt_key_word STAT EQUAL ident
|
|
|
|
|
{ stat_alloc = $6; }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
allocate_object_list: allocate_object
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| allocate_object_list COMMA in_ioctl allocate_object
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); endioctl(); }
|
|
|
|
|
| allocate_object_list COMMA in_ioctl nameeq ident
|
|
|
|
|
{ stat_alloc = make_llnd(fi, SPEC_PAIR, $4, $5, SMNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
opt_stat_spec:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| COMMA needkeyword STAT EQUAL ident
|
|
|
|
|
{ $$ = $5; }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
stat_spec:
|
|
|
|
|
{stat_alloc = LLNULL;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
pointer_name_list: ident
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| pointer_name_list COMMA ident
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* Grammar for executable statements
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
exec: iffable
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| whereable
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| plain_do
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| construct_name_colon plain_do
|
|
|
|
|
{
|
|
|
|
|
$$ = $2;
|
|
|
|
|
$$->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
}
|
|
|
|
|
/*
|
|
|
|
|
|
|
|
|
|
| PLAINDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if(!$4){
|
|
|
|
|
err("No label in DO statement");
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
if( $4->labdefined)
|
|
|
|
|
execerr("no backward DO loops", (char *)NULL);
|
|
|
|
|
$$ = make_do(FOR_NODE, $4, $7, $9, $11, NULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
| PLAINDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if(!$4){
|
|
|
|
|
err("No label in DO statement");
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
if( $4->labdefined)
|
|
|
|
|
execerr("no backward DO loops", (char *)NULL);
|
|
|
|
|
$$ = make_do(FOR_NODE, $4, $7, $9, $11, $13);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
/* PROCESSDO added for FORTRAN M
|
|
|
|
|
| opt_construct_name_colon PROCESSDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if( !do_name_err ) {
|
|
|
|
|
if($5 && $5->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_processdo(PROCESS_DO_STAT, $5, $8, $10, $12, NULL);
|
|
|
|
|
$$->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| opt_construct_name_colon PROCESSDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if( !do_name_err ) {
|
|
|
|
|
if($5 && $5->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_processdo(PROCESS_DO_STAT, $5, $8, $10, $12, $14);
|
|
|
|
|
$$->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
| ENDUNIT end_spec opt_unit_name
|
|
|
|
|
{ PTR_BFND biff;
|
|
|
|
|
|
|
|
|
|
$$ = get_bfnd(fi,CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
bind();
|
|
|
|
|
biff = cur_scope();
|
|
|
|
|
if ((biff->variant == FUNC_HEDR) || (biff->variant == PROC_HEDR)
|
|
|
|
|
|| (biff->variant == PROS_HEDR)
|
|
|
|
|
|| (biff->variant == PROG_HEDR)
|
|
|
|
|
|| (biff->variant == BLOCK_DATA)) {
|
|
|
|
|
if(biff->control_parent == global_bfnd) position = IN_OUTSIDE;
|
|
|
|
|
else if(!is_interface_stat(biff->control_parent)) position++;
|
|
|
|
|
} else if (biff->variant == MODULE_STMT)
|
|
|
|
|
position = IN_OUTSIDE;
|
|
|
|
|
else err("Unexpected END statement read", 52);
|
|
|
|
|
/* FB ADDED set the control parent so the empty function unparse right*/
|
|
|
|
|
if ($$)
|
|
|
|
|
$$->control_parent = biff;
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
}
|
|
|
|
|
| ENDDO end_spec opt_construct_name
|
|
|
|
|
/* { $$ = get_bfnd(fi,CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);}*/
|
|
|
|
|
/* Had to be changed to accomodate PCF's do loops. */
|
|
|
|
|
{
|
|
|
|
|
make_extend($3);
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
/* delete_beyond_scope_level(pred_bfnd); */
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* ENDPROCESSDO was added by C.Y.Chen
|
|
|
|
|
| ENDPROCESSDO end_spec
|
|
|
|
|
{ $$ = make_enddoall(); }
|
|
|
|
|
*/
|
|
|
|
|
/* end module is bit different. So shouldn't have end_spec. */
|
|
|
|
|
/* It may be better to move it to spec. */
|
|
|
|
|
| ENDMODULE opt_unit_name
|
|
|
|
|
{ $$ = get_bfnd(fi,CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
bind();
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
position = IN_OUTSIDE;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
| opt_construct_name_colon DOWHILE end_spec needkeyword intonlyon dotarget intonlyoff WHILE LEFTPAR expr RIGHTPAR */
|
|
|
|
|
| do_while
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
|
|
|
|
|
| construct_name_colon do_while
|
|
|
|
|
{
|
|
|
|
|
$$ = $2;
|
|
|
|
|
$$->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* | CDOALL do_var EQUAL expr COMMA expr
|
|
|
|
|
{$$ = make_do(CDOALL_NODE, NULL, $2, $4, $6, NULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| CDOALL do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{$$ = make_do(CDOALL_NODE, NULL, $2, $4, $6, $8);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| SDOALL do_var EQUAL expr COMMA expr
|
|
|
|
|
{$$ = make_do(SDOALL_NODE, NULL, $2, $4, $6, NULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| SDOALL do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{$$ = make_do(SDOALL_NODE, NULL, $2, $4, $6, $8);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| DOACROSS do_var EQUAL expr COMMA expr
|
|
|
|
|
{$$ = make_do(DOACROSS_NODE, NULL, $2, $4, $6, NULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| DOACROSS do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{$$ = make_do(DOACROSS_NODE, NULL, $2, $4, $6, $8);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| CDOACROSS do_var EQUAL expr COMMA expr
|
|
|
|
|
{$$ = make_do(CDOACROSS_NODE, NULL, $2, $4, $6, NULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| CDOACROSS do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{$$ = make_do(CDOACROSS_NODE, NULL, $2, $4, $6, $8);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
}
|
|
|
|
|
| LOOP
|
|
|
|
|
{
|
|
|
|
|
make_loop();
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| enddoall
|
|
|
|
|
{ $$ = make_enddoall();
|
|
|
|
|
delete_beyond_scope_level(pred_bfnd);
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
| logif iffable
|
|
|
|
|
{ thiswasbranch = NO;
|
|
|
|
|
$1->variant = LOGIF_NODE;
|
|
|
|
|
$$ = make_logif($1, $2);
|
|
|
|
|
set_blobs($1, pred_bfnd, SAME_GROUP);
|
|
|
|
|
}
|
|
|
|
|
| logif THEN
|
|
|
|
|
{
|
|
|
|
|
$$ = $1;
|
|
|
|
|
set_blobs($$, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
}
|
|
|
|
|
| construct_name_colon logif THEN
|
|
|
|
|
{
|
|
|
|
|
$$ = $2;
|
|
|
|
|
$$->entry.Template.ll_ptr3 = $1;
|
|
|
|
|
set_blobs($$, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
}
|
|
|
|
|
/* | CONSTRUCT_ID COLON logif THEN
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
|
|
|
|
|
s = make_local_entity(look_up_sym(yytext), CONSTRUCT_NAME, global_default, LOCAL);
|
|
|
|
|
l = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
* $$ = make_if($3); *
|
|
|
|
|
$3->entry.Template.ll_ptr3 = l;
|
|
|
|
|
$$ = $3;
|
|
|
|
|
set_blobs($$, pred_bfnd, NEW_GROUP1);
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
| ELSEIF end_spec LEFTPAR expr RIGHTPAR THEN opt_construct_name
|
|
|
|
|
{ make_elseif($4,$7); lastwasbranch = NO; $$ = BFNULL;}
|
|
|
|
|
| ELSE end_spec opt_construct_name
|
|
|
|
|
{ make_else($3); lastwasbranch = NO; $$ = BFNULL; }
|
|
|
|
|
| ENDIF end_spec opt_construct_name
|
|
|
|
|
{ make_endif($3); $$ = BFNULL; }
|
|
|
|
|
| case
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| CONTAINS end_spec
|
|
|
|
|
{ $$ = get_bfnd(fi, CONTAINS_STMT, SMNULL, LLNULL, LLNULL, LLNULL); }
|
|
|
|
|
|
|
|
|
|
| forall iffable
|
|
|
|
|
{ thiswasbranch = NO;
|
|
|
|
|
$1->variant = FORALL_STAT;
|
|
|
|
|
$$ = make_logif($1, $2);
|
|
|
|
|
set_blobs($1, pred_bfnd, SAME_GROUP);
|
|
|
|
|
}
|
|
|
|
|
| forall
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| construct_name_colon forall
|
|
|
|
|
{ $$ = $2; $$->entry.Template.ll_ptr3 = $1;}
|
|
|
|
|
| ENDFORALL end_spec opt_construct_name
|
|
|
|
|
{ make_endforall($3); $$ = BFNULL; }
|
|
|
|
|
|
|
|
|
|
| dvm_exec
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| acc_directive
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| spf_directive
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
do_while: DOWHILE end_spec LEFTPAR expr RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
|
|
|
|
|
$$ = make_do(WHILE_NODE, LBNULL, SMNULL, $4, LLNULL, LLNULL);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
| DOWHILE end_spec intonlyon dotarget intonlyoff needkeyword WHILE LEFTPAR expr RIGHTPAR
|
|
|
|
|
|
|
|
|
|
{
|
|
|
|
|
if($4 && $4->labdefined)
|
|
|
|
|
execerr("no backward DO loops", (char *)NULL);
|
|
|
|
|
$$ = make_do(WHILE_NODE, $4, SMNULL, $9, LLNULL, LLNULL);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
| DOWHILE end_spec intonlyon dotarget intonlyoff
|
|
|
|
|
{
|
|
|
|
|
if( $4 && $4->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_do(WHILE_NODE, $4, SMNULL, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
do_while: DOWHILE end_spec LEFTPAR expr RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
/* if($5 && $5->labdefined)
|
|
|
|
|
execerr("no backward DO loops", (char *)NULL); */
|
|
|
|
|
$$ = make_do(WHILE_NODE, LBNULL, SMNULL, $4, LLNULL, LLNULL);
|
|
|
|
|
/*$$->entry.Template.ll_ptr3 = $1;*/
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| DOWHILE end_spec intonlyon dotarget intonlyoff opt_key_word opt_while
|
|
|
|
|
{
|
|
|
|
|
if( $4 && $4->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_do(WHILE_NODE, $4, SMNULL, $7, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_while:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| COMMA needkeyword WHILE LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = $5;}
|
|
|
|
|
| WHILE LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = $3;}
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
plain_do: PLAINDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if( $4 && $4->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_do(FOR_NODE, $4, $7, $9, $11, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| PLAINDO end_spec intonlyon dotarget intonlyoff opt_comma do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
{
|
|
|
|
|
if( $4 && $4->labdefined)
|
|
|
|
|
err("No backward DO loops", 46);
|
|
|
|
|
$$ = make_do(FOR_NODE, $4, $7, $9, $11, $13);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
case: CASE end_spec case_selector opt_construct_name
|
|
|
|
|
{ $$ = get_bfnd(fi, CASE_NODE, $4, $3, LLNULL, LLNULL); }
|
|
|
|
|
| DEFAULT_CASE end_spec opt_construct_name
|
|
|
|
|
{ /*PTR_LLND p;*/
|
|
|
|
|
/* p = make_llnd(fi, DEFAULT, LLNULL, LLNULL, SMNULL); */
|
|
|
|
|
$$ = get_bfnd(fi, DEFAULT_NODE, $3, LLNULL, LLNULL, LLNULL); }
|
|
|
|
|
| ENDSELECT end_spec opt_construct_name
|
|
|
|
|
{ make_endselect($3); $$ = BFNULL; }
|
|
|
|
|
/* { $$ = get_bfnd(fi, CONTROL_END, $3, LLNULL, LLNULL, LLNULL); }*/
|
|
|
|
|
| SELECT end_spec needkeyword CASE LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, SWITCH_NODE, SMNULL, $6, LLNULL, LLNULL) ; }
|
|
|
|
|
| construct_name_colon SELECT end_spec needkeyword CASE LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, SWITCH_NODE, SMNULL, $7, LLNULL, $1) ; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
case_selector: LEFTPAR case_value_range_list RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
/* | DEFAULT_CASE
|
|
|
|
|
{ $$ = make_llnd(fi, DEFAULT, LLNULL, LLNULL, SMNULL); }
|
|
|
|
|
*/ ;
|
|
|
|
|
|
|
|
|
|
case_value_range: expr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| expr COLON
|
|
|
|
|
{ $$ = make_llnd(fi, DDOT, $1, LLNULL, SMNULL); }
|
|
|
|
|
| COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi, DDOT, LLNULL, $2, SMNULL); }
|
|
|
|
|
| expr COLON expr
|
|
|
|
|
{ $$ = make_llnd(fi, DDOT, $1, $3, SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
case_value_range_list: case_value_range
|
|
|
|
|
{ $$ = make_llnd(fi, EXPR_LIST, $1, LLNULL, SMNULL); }
|
|
|
|
|
| case_value_range_list COMMA case_value_range
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(p, $1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_construct_name:
|
|
|
|
|
{ $$ = SMNULL; }
|
|
|
|
|
| name
|
|
|
|
|
{ $$ = make_local_entity($1, CONSTRUCT_NAME, global_default,
|
|
|
|
|
LOCAL); }
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_unit_name:
|
|
|
|
|
{$$ = HSNULL;}
|
|
|
|
|
| name
|
|
|
|
|
{ $$ = $1;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
construct_name: CONSTRUCT_ID
|
|
|
|
|
{$$ = look_up_sym(yytext);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
construct_name_colon: construct_name COLON
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = make_local_entity( $1, CONSTRUCT_NAME, global_default, LOCAL);
|
|
|
|
|
$$ = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
opt_construct_name_colon:
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
| construct_name COLON
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = make_local_entity( $1, CONSTRUCT_NAME, global_default, LOCAL);
|
|
|
|
|
$$ = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
/*
|
|
|
|
|
optkeyword:
|
|
|
|
|
{opt_kwd_ = YES;}
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
logif: LOGICALIF end_spec LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = make_if($4); }
|
|
|
|
|
;
|
|
|
|
|
forall: FORALL end_spec LEFTPAR forall_list opt_forall_cond RIGHTPAR
|
|
|
|
|
{ $$ = make_forall($4,$5); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
forall_list: forall_expr
|
|
|
|
|
{ $$ = make_llnd(fi, EXPR_LIST, $1, LLNULL, SMNULL); }
|
|
|
|
|
| forall_list COMMA forall_expr
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
p = make_llnd(fi, EXPR_LIST, $3, LLNULL, SMNULL);
|
|
|
|
|
add_to_lowLevelList(p, $1);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
forall_expr: do_var EQUAL triplet
|
|
|
|
|
{$$ = make_llnd(fi, FORALL_OP, $3, LLNULL, $1); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_forall_cond:
|
|
|
|
|
{ $$=LLNULL;}
|
|
|
|
|
| COMMA expr
|
|
|
|
|
{ $$=$2;}
|
|
|
|
|
;
|
|
|
|
|
/*
|
|
|
|
|
enddoall: ENDCDOALL
|
|
|
|
|
| ENDSDOALL
|
|
|
|
|
| ENDDOACROSS
|
|
|
|
|
| ENDCDOACROSS
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
do_var: name
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
s = $1->id_attr;
|
|
|
|
|
if (!s || s->variant == DEFAULT)
|
|
|
|
|
{
|
|
|
|
|
s = make_scalar($1, TYNULL, LOCAL);
|
|
|
|
|
s->decl = SOFT;
|
|
|
|
|
}
|
|
|
|
|
$$ = s;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
dospec: do_var EQUAL expr COMMA expr
|
|
|
|
|
/* name EQUAL expr COMMA expr*/ /*16.02.03*/
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
int vrnt;
|
|
|
|
|
|
|
|
|
|
/* s = make_scalar($1, TYNULL, LOCAL);*/ /*16.02.03*/
|
|
|
|
|
s = $1;
|
|
|
|
|
if (s->variant != CONST_NAME) {
|
|
|
|
|
if(in_vec)
|
|
|
|
|
vrnt=SEQ;
|
|
|
|
|
else
|
|
|
|
|
vrnt=DDOT;
|
|
|
|
|
l = make_llnd(fi, SEQ, make_llnd(fi, vrnt, $3, $5, SMNULL),
|
|
|
|
|
LLNULL, SMNULL);
|
|
|
|
|
$$ = make_llnd(fi,IOACCESS, LLNULL, l, s);
|
|
|
|
|
do_name_err = NO;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
err("Symbolic constant not allowed as DO variable", 47);
|
|
|
|
|
do_name_err = YES;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| do_var EQUAL expr COMMA expr COMMA expr
|
|
|
|
|
/*name EQUAL expr COMMA expr COMMA expr*/ /*16.02.03*/
|
|
|
|
|
{ PTR_SYMB s;
|
|
|
|
|
PTR_LLND l;
|
|
|
|
|
int vrnt;
|
|
|
|
|
/*s = make_scalar($1, TYNULL, LOCAL);*/ /*16.02.03*/
|
|
|
|
|
s = $1;
|
|
|
|
|
if( s->variant != CONST_NAME ) {
|
|
|
|
|
if(in_vec)
|
|
|
|
|
vrnt=SEQ;
|
|
|
|
|
else
|
|
|
|
|
vrnt=DDOT;
|
|
|
|
|
l = make_llnd(fi, SEQ, make_llnd(fi, vrnt, $3, $5, SMNULL), $7,
|
|
|
|
|
SMNULL);
|
|
|
|
|
$$ = make_llnd(fi,IOACCESS, LLNULL, l, s);
|
|
|
|
|
do_name_err = NO;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
err("Symbolic constant not allowed as DO variable", 47);
|
|
|
|
|
do_name_err = YES;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
dotarget: { $$ = LBNULL; }
|
|
|
|
|
| INT_CONSTANT
|
|
|
|
|
{
|
|
|
|
|
$$ = make_label_node(fi,convci(yyleng, yytext));
|
|
|
|
|
$$->scope = cur_scope();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
whereable: ENDWHERE end_spec opt_construct_name
|
|
|
|
|
{ make_endwhere($3); $$ = BFNULL; }
|
|
|
|
|
| ELSEWHERE end_spec opt_construct_name
|
|
|
|
|
{ make_elsewhere($3); lastwasbranch = NO; $$ = BFNULL; }
|
|
|
|
|
| ELSEWHERE end_spec LEFTPAR expr RIGHTPAR opt_construct_name
|
|
|
|
|
{ make_elsewhere_mask($4,$6); lastwasbranch = NO; $$ = BFNULL; }
|
|
|
|
|
| WHERE end_spec LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, WHERE_BLOCK_STMT, SMNULL, $4, LLNULL, LLNULL); }
|
|
|
|
|
| construct_name_colon WHERE end_spec LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, WHERE_BLOCK_STMT, SMNULL, $5, LLNULL, $1); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iffable: let expr EQUAL expr
|
|
|
|
|
/* let lhs EQUAL expr */
|
|
|
|
|
{ PTR_LLND p, r;
|
|
|
|
|
PTR_SYMB s1, s2 = SMNULL, s3, arg_list;
|
|
|
|
|
PTR_HASH hash_entry;
|
|
|
|
|
|
|
|
|
|
/* if (just_look_up_sym("=") != HSNULL) {
|
|
|
|
|
p = intrinsic_op_node("=", EQUAL, $2, $4);
|
|
|
|
|
$$ = get_bfnd(fi, OVERLOADED_ASSIGN_STAT, SMNULL, p, $2, $4);
|
|
|
|
|
}
|
|
|
|
|
else */ if ($2->variant == FUNC_CALL) {
|
|
|
|
|
if(parstate==INEXEC){
|
|
|
|
|
err("Declaration among executables", 30);
|
|
|
|
|
/* $$=BFNULL;*/
|
|
|
|
|
$$ = get_bfnd(fi,STMTFN_STAT, SMNULL, $2, LLNULL, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$2->variant = STMTFN_DECL;
|
|
|
|
|
/* $2->entry.Template.ll_ptr2 = $4; */
|
|
|
|
|
if( $2->entry.Template.ll_ptr1) {
|
|
|
|
|
r = $2->entry.Template.ll_ptr1->entry.Template.ll_ptr1;
|
|
|
|
|
if(r->variant != VAR_REF && r->variant != ARRAY_REF){
|
|
|
|
|
err("A dummy argument of a statement function must be a scalar identifier", 333);
|
|
|
|
|
s1 = SMNULL;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
s1 = r ->entry.Template.symbol;
|
|
|
|
|
} else
|
|
|
|
|
s1 = SMNULL;
|
|
|
|
|
if (s1)
|
|
|
|
|
s1->scope = cur_scope();
|
|
|
|
|
$$ = get_bfnd(fi,STMTFN_STAT, SMNULL, $2, LLNULL, LLNULL);
|
|
|
|
|
add_scope_level($$, NO);
|
|
|
|
|
arg_list = SMNULL;
|
|
|
|
|
if (s1)
|
|
|
|
|
{
|
|
|
|
|
/*arg_list = SMNULL;*/
|
|
|
|
|
p = $2->entry.Template.ll_ptr1;
|
|
|
|
|
while (p != LLNULL)
|
|
|
|
|
{
|
|
|
|
|
/* if (p->entry.Template.ll_ptr1->variant != VAR_REF) {
|
|
|
|
|
errstr("cftn.gram:1: illegal statement function %s.", $2->entry.Template.symbol->ident);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
r = p->entry.Template.ll_ptr1;
|
|
|
|
|
if(r->variant != VAR_REF && r->variant != ARRAY_REF){
|
|
|
|
|
err("A dummy argument of a statement function must be a scalar identifier", 333);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
hash_entry = look_up_sym(r->entry.Template.symbol->parent->ident);
|
|
|
|
|
s3 = make_scalar(hash_entry, s1->type, IO);
|
|
|
|
|
replace_symbol_in_expr(s3,$4);
|
|
|
|
|
if (arg_list == SMNULL)
|
|
|
|
|
s2 = arg_list = s3;
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
s2->id_list = s3;
|
|
|
|
|
s2 = s3;
|
|
|
|
|
}
|
|
|
|
|
p = p->entry.Template.ll_ptr2;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
$2->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
install_param_list($2->entry.Template.symbol,
|
|
|
|
|
arg_list, LLNULL, FUNCTION_NAME);
|
|
|
|
|
delete_beyond_scope_level($$);
|
|
|
|
|
|
|
|
|
|
/* else
|
|
|
|
|
errstr("cftn.gram: Illegal statement function declaration %s.", $2->entry.Template.symbol->ident); */
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$$ = get_bfnd(fi,ASSIGN_STAT,SMNULL, $2, $4, LLNULL);
|
|
|
|
|
parstate = INEXEC;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| POINTERLET end_spec lhs POINT_TO expr
|
|
|
|
|
{ /*PTR_SYMB s;*/
|
|
|
|
|
|
|
|
|
|
/*s = make_scalar($2, TYNULL, LOCAL);*/
|
|
|
|
|
$$ = get_bfnd(fi, POINTER_ASSIGN_STAT, SMNULL, $3, $5, LLNULL);
|
|
|
|
|
}
|
|
|
|
|
/* | let lhs EQUAL vec
|
|
|
|
|
|
|
|
|
|
{ if ($2->variant == ARRAY_REF)
|
|
|
|
|
$$ = get_bfnd(fi,ASSIGN_STAT,SMNULL, $2, $4, LLNULL);
|
|
|
|
|
else err("Constructor reference");
|
|
|
|
|
}
|
|
|
|
|
*/ | ASSIGN end_spec label TO name
|
|
|
|
|
{ PTR_SYMB p;
|
|
|
|
|
|
|
|
|
|
p = make_scalar($5, TYNULL, LOCAL);
|
|
|
|
|
p->variant = LABEL_VAR;
|
|
|
|
|
$$ = get_bfnd(fi,ASSLAB_STAT, p, $3,LLNULL,LLNULL);
|
|
|
|
|
}
|
|
|
|
|
| CONTINUE end_spec
|
|
|
|
|
{ $$ = get_bfnd(fi,CONT_STAT,SMNULL,LLNULL,LLNULL,LLNULL); }
|
|
|
|
|
| goto
|
|
|
|
|
| io
|
|
|
|
|
{ inioctl = NO; }
|
|
|
|
|
| ARITHIF end_spec LEFTPAR expr RIGHTPAR label COMMA label COMMA label
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $10, LLNULL, SMNULL);
|
|
|
|
|
p = make_llnd(fi,EXPR_LIST, $8, p, SMNULL);
|
|
|
|
|
$$= get_bfnd(fi,ARITHIF_NODE, SMNULL, $4,
|
|
|
|
|
make_llnd(fi,EXPR_LIST, $6, p, SMNULL), LLNULL);
|
|
|
|
|
thiswasbranch = YES;
|
|
|
|
|
}
|
|
|
|
|
| call
|
|
|
|
|
{
|
|
|
|
|
$$ = subroutine_call($1, LLNULL, LLNULL, PLAIN);
|
|
|
|
|
/* match_parameters($1, LLNULL);
|
|
|
|
|
$$= get_bfnd(fi,PROC_STAT, $1, LLNULL, LLNULL, LLNULL);
|
|
|
|
|
*/ endioctl();
|
|
|
|
|
}
|
|
|
|
|
| call LEFTPAR RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$$ = subroutine_call($1, LLNULL, LLNULL, PLAIN);
|
|
|
|
|
/* match_parameters($1, LLNULL);
|
|
|
|
|
$$= get_bfnd(fi,PROC_STAT,$1,LLNULL,LLNULL,LLNULL);
|
|
|
|
|
*/ endioctl();
|
|
|
|
|
}
|
|
|
|
|
| call LEFTPAR callarglist RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$$ = subroutine_call($1, $3, LLNULL, PLAIN);
|
|
|
|
|
/* match_parameters($1, $3);
|
|
|
|
|
$$= get_bfnd(fi,PROC_STAT,$1,$3,LLNULL,LLNULL);
|
|
|
|
|
*/ endioctl();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
| RETURN end_spec opt_expr
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi,RETURN_STAT,SMNULL,$3,LLNULL,LLNULL);
|
|
|
|
|
thiswasbranch = YES;
|
|
|
|
|
}
|
|
|
|
|
| stop end_spec opt_expr
|
|
|
|
|
{
|
|
|
|
|
$$ = get_bfnd(fi,$1,SMNULL,$3,LLNULL,LLNULL);
|
|
|
|
|
thiswasbranch = ($1 == STOP_STAT);
|
|
|
|
|
}
|
|
|
|
|
| CYCLE end_spec opt_construct_name
|
|
|
|
|
{ $$ = get_bfnd(fi, CYCLE_STMT, $3, LLNULL, LLNULL, LLNULL); }
|
|
|
|
|
|
|
|
|
|
| EXIT end_spec opt_construct_name
|
|
|
|
|
{ $$ = get_bfnd(fi, EXIT_STMT, $3, LLNULL, LLNULL, LLNULL); }
|
|
|
|
|
|
|
|
|
|
| ALLOCATE end_spec LEFTPAR stat_spec allocation_list RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, ALLOCATE_STMT, SMNULL, $5, stat_alloc, LLNULL); }
|
|
|
|
|
|
|
|
|
|
| DEALLOCATE end_spec LEFTPAR stat_spec allocate_object_list RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, DEALLOCATE_STMT, SMNULL, $5, stat_alloc , LLNULL); }
|
|
|
|
|
|
|
|
|
|
| NULLIFY end_spec LEFTPAR pointer_name_list RIGHTPAR
|
|
|
|
|
{ $$ = get_bfnd(fi, NULLIFY_STMT, SMNULL, $4, LLNULL, LLNULL); }
|
|
|
|
|
|
|
|
|
|
| WHERE_ASSIGN end_spec LEFTPAR expr RIGHTPAR lhs EQUAL expr
|
|
|
|
|
{ $$ = get_bfnd(fi, WHERE_NODE, SMNULL, $4, $6, $8); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
let: LET in_data
|
|
|
|
|
/*
|
|
|
|
|
{ if(parstate == OUTSIDE)
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR, make_program(look_up_sym("_MAIN")), LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
}
|
|
|
|
|
if(parstate < INDATA) enddcl();
|
|
|
|
|
parstate = INEXEC;
|
|
|
|
|
yystno = 0;
|
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
{$$ = LLNULL;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
goto: PLAINGOTO end_spec label
|
|
|
|
|
{
|
|
|
|
|
$$=get_bfnd(fi,GOTO_NODE,SMNULL,LLNULL,LLNULL,(PTR_LLND)$3);
|
|
|
|
|
thiswasbranch = YES;
|
|
|
|
|
}
|
|
|
|
|
| ASSIGNGOTO end_spec name
|
|
|
|
|
{ PTR_SYMB p;
|
|
|
|
|
|
|
|
|
|
if($3->id_attr)
|
|
|
|
|
p = $3->id_attr;
|
|
|
|
|
else {
|
|
|
|
|
p = make_scalar($3, TYNULL, LOCAL);
|
|
|
|
|
p->variant = LABEL_VAR;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if(p->variant == LABEL_VAR) {
|
|
|
|
|
$$ = get_bfnd(fi,ASSGOTO_NODE,p,LLNULL,LLNULL,LLNULL);
|
|
|
|
|
thiswasbranch = YES;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
err("Must go to assigned variable", 48);
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| ASSIGNGOTO end_spec name opt_comma LEFTPAR labellist RIGHTPAR
|
|
|
|
|
{ PTR_SYMB p;
|
|
|
|
|
|
|
|
|
|
if($3->id_attr)
|
|
|
|
|
p = $3->id_attr;
|
|
|
|
|
else {
|
|
|
|
|
p = make_scalar($3, TYNULL, LOCAL);
|
|
|
|
|
p->variant = LABEL_VAR;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (p->variant == LABEL_VAR) {
|
|
|
|
|
$$ = get_bfnd(fi,ASSGOTO_NODE,p,$6,LLNULL,LLNULL);
|
|
|
|
|
thiswasbranch = YES;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
err("Must go to assigned variable",48);
|
|
|
|
|
$$ = BFNULL;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
| COMPGOTO end_spec LEFTPAR labellist RIGHTPAR opt_comma expr
|
|
|
|
|
{ $$ = get_bfnd(fi,COMGOTO_NODE, SMNULL, $4, $7, LLNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
opt_comma:
|
|
|
|
|
| COMMA
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
call: CALL end_spec name in_ioctl
|
|
|
|
|
{ $$ = make_procedure($3, LOCAL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
callarglist: in_ioctl callarg
|
|
|
|
|
{
|
|
|
|
|
$$ = set_ll_list($2, LLNULL, EXPR_LIST);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| callarglist COMMA in_ioctl callarg
|
|
|
|
|
{
|
|
|
|
|
$$ = set_ll_list($1, $4, EXPR_LIST);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
callarg: expr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| nameeq expr
|
|
|
|
|
{ $$ = make_llnd(fi, KEYWORD_ARG, $1, $2, SMNULL); }
|
|
|
|
|
| ASTER label
|
|
|
|
|
{ $$ = make_llnd(fi,LABEL_ARG,$2,LLNULL,SMNULL); }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
stop: PAUSE { $$ = PAUSE_NODE; }
|
|
|
|
|
| STOP { $$ = STOP_STAT; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
exprlist: expr
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); }
|
|
|
|
|
| exprlist COMMA expr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); }
|
|
|
|
|
;
|
|
|
|
|
*/
|
|
|
|
|
end_spec:
|
|
|
|
|
{ if(parstate == OUTSIDE)
|
|
|
|
|
{ PTR_BFND p;
|
|
|
|
|
|
|
|
|
|
p = get_bfnd(fi,PROG_HEDR, make_program(look_up_sym("_MAIN")), LLNULL, LLNULL, LLNULL);
|
|
|
|
|
set_blobs(p, global_bfnd, NEW_GROUP1);
|
|
|
|
|
add_scope_level(p, NO);
|
|
|
|
|
position = IN_PROC;
|
|
|
|
|
}
|
|
|
|
|
if(parstate < INDATA) enddcl();
|
|
|
|
|
parstate = INEXEC;
|
|
|
|
|
yystno = 0;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intonlyon:
|
|
|
|
|
{ intonly = YES; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
intonlyoff:
|
|
|
|
|
{ intonly = NO; }
|
|
|
|
|
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* Grammar for Input/Output statements
|
|
|
|
|
*/
|
|
|
|
|
io: iofmove ioctl
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| iofmove unpar_fexpr
|
|
|
|
|
{ PTR_LLND p, q = LLNULL;
|
|
|
|
|
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
p = make_llnd(fi, SPEC_PAIR, q, $2, SMNULL);
|
|
|
|
|
$1->entry.Template.ll_ptr2 = p;
|
|
|
|
|
endioctl();
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| iofmove ASTER
|
|
|
|
|
{ PTR_LLND p, q, r;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
r = make_llnd(fi, SPEC_PAIR, p, q, SMNULL);
|
|
|
|
|
$1->entry.Template.ll_ptr2 = r;
|
|
|
|
|
endioctl();
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| iofmove DASTER
|
|
|
|
|
{ PTR_LLND p, q, r;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"**";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
r = make_llnd(fi, SPEC_PAIR, p, q, SMNULL);
|
|
|
|
|
$1->entry.Template.ll_ptr2 = r;
|
|
|
|
|
endioctl();
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| iofctl ioctl
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| inquire
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| read ioctl
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| read infmt
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| read ioctl inlist
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| read infmt COMMA inlist
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
/* | read ioctl COMMA inlist Not needed
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $4;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
*/
|
|
|
|
|
| write ioctl
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| write ioctl outlist
|
|
|
|
|
{ $1->entry.Template.ll_ptr2 = $2;
|
|
|
|
|
$1->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
| print
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| print COMMA outlist
|
|
|
|
|
{ $1->entry.Template.ll_ptr1 = $3;
|
|
|
|
|
$$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
iofmove: fmkwd end_spec start_ioctl
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
fmkwd: BACKSPACE
|
|
|
|
|
{$$ = get_bfnd(fi, BACKSPACE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
| REWIND
|
|
|
|
|
{$$ = get_bfnd(fi, REWIND_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
| ENDFILE
|
|
|
|
|
{$$ = get_bfnd(fi, ENDFILE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
/* | SKIPPASTEOF
|
|
|
|
|
{$$ = get_bfnd(fi, SKIPPASTEOF_NODE, SMNULL, LLNULL, LLNULL, LLNULL); }
|
|
|
|
|
*/
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
iofctl: ctlkwd end_spec start_ioctl
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
ctlkwd: OPEN
|
|
|
|
|
{$$ = get_bfnd(fi, OPEN_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
| CLOSE
|
|
|
|
|
{$$ = get_bfnd(fi, CLOSE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
inquire: INQUIRE end_spec start_ioctl ioctl
|
|
|
|
|
{ $$ = get_bfnd(fi, INQUIRE_STAT, SMNULL, LLNULL, $4, LLNULL);}
|
|
|
|
|
| INQUIRE end_spec start_ioctl ioctl outlist
|
|
|
|
|
{ $$ = get_bfnd(fi, INQUIRE_STAT, SMNULL, $5, $4, LLNULL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
infmt: unpar_fexpr
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
PTR_LLND q = LLNULL;
|
|
|
|
|
|
|
|
|
|
if ($1->variant == INT_VAL)
|
|
|
|
|
{
|
|
|
|
|
PTR_LABEL r;
|
|
|
|
|
|
|
|
|
|
r = make_label_node(fi, (long) $1->entry.ival);
|
|
|
|
|
r->scope = cur_scope();
|
|
|
|
|
p = make_llnd_label(fi, LABEL_REF, r);
|
|
|
|
|
}
|
|
|
|
|
else p = $1;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| ASTER
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ioctl: LEFTPAR fexpr RIGHTPAR
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"unit";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, p, $2, SMNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| LEFTPAR ctllist RIGHTPAR
|
|
|
|
|
|
|
|
|
|
/*ioctl: LEFTPAR ctllist RIGHTPAR*/
|
|
|
|
|
{
|
|
|
|
|
$$ = $2;
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
ctllist: ioclause
|
|
|
|
|
{ $$ = $1; endioctl();}
|
|
|
|
|
| ctllist COMMA in_ioctl ioclause
|
|
|
|
|
{ $$ = set_ll_list($1, $4, EXPR_LIST); endioctl();}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
ioclause: fexpr
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
|
|
|
|
|
nioctl++;
|
|
|
|
|
if ((nioctl == 2) && ($1->variant == INT_VAL))
|
|
|
|
|
{
|
|
|
|
|
PTR_LABEL r;
|
|
|
|
|
|
|
|
|
|
r = make_label_node(fi, (long) $1->entry.ival);
|
|
|
|
|
r->scope = cur_scope();
|
|
|
|
|
p = make_llnd_label(fi, LABEL_REF, r);
|
|
|
|
|
}
|
|
|
|
|
else p = $1;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
if (nioctl == 1)
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
else {
|
|
|
|
|
if(($1->variant == VAR_REF) && $1->entry.Template.symbol->variant == NAMELIST_NAME)
|
|
|
|
|
q->entry.string_val = (char *)"nml";
|
|
|
|
|
else
|
|
|
|
|
q->entry.string_val = (char *)"fmt";
|
|
|
|
|
}
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| ASTER
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
|
|
|
|
|
nioctl++;
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
if (nioctl == 1)
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
else q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| DASTER
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
PTR_LLND q;
|
|
|
|
|
|
|
|
|
|
nioctl++;
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"**";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
if (nioctl == 1)
|
|
|
|
|
q->entry.string_val = (char *)"unit";
|
|
|
|
|
else q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| nameeq expr
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p;
|
|
|
|
|
char *q;
|
|
|
|
|
|
|
|
|
|
q = $1->entry.string_val;
|
|
|
|
|
if ((strcmp(q, "end") == 0) || (strcmp(q, "err") == 0) || (strcmp(q, "eor") == 0) || ((strcmp(q,"fmt") == 0) && ($2->variant == INT_VAL)))
|
|
|
|
|
{
|
|
|
|
|
PTR_LABEL r;
|
|
|
|
|
|
|
|
|
|
r = make_label_node(fi, (long) $2->entry.ival);
|
|
|
|
|
r->scope = cur_scope();
|
|
|
|
|
p = make_llnd_label(fi, LABEL_REF, r);
|
|
|
|
|
}
|
|
|
|
|
else p = $2;
|
|
|
|
|
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, $1, p, SMNULL); }
|
|
|
|
|
| nameeq ASTER
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, $1, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
| nameeq DASTER
|
|
|
|
|
{ PTR_LLND p;
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
$$ = make_llnd(fi, SPEC_PAIR, $1, p, SMNULL);
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
nameeq: NAMEEQ
|
|
|
|
|
{ $$ = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
$$->entry.string_val = copys(yytext);
|
|
|
|
|
$$->type = global_string;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
read: READ end_spec start_ioctl
|
|
|
|
|
{$$ = get_bfnd(fi, READ_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write: WRITE end_spec start_ioctl
|
|
|
|
|
{$$ = get_bfnd(fi, WRITE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
print: PRINT end_spec fexpr start_ioctl
|
|
|
|
|
{
|
|
|
|
|
PTR_LLND p, q, l;
|
|
|
|
|
|
|
|
|
|
if ($3->variant == INT_VAL)
|
|
|
|
|
{
|
|
|
|
|
PTR_LABEL r;
|
|
|
|
|
|
|
|
|
|
r = make_label_node(fi, (long) $3->entry.ival);
|
|
|
|
|
r->scope = cur_scope();
|
|
|
|
|
p = make_llnd_label(fi, LABEL_REF, r);
|
|
|
|
|
}
|
|
|
|
|
else p = $3;
|
|
|
|
|
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
l = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
|
|
|
|
|
$$ = get_bfnd(fi, PRINT_STAT, SMNULL, LLNULL, l, LLNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
| PRINT end_spec ASTER start_ioctl
|
|
|
|
|
{ PTR_LLND p, q, r;
|
|
|
|
|
|
|
|
|
|
p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
p->entry.string_val = (char *)"*";
|
|
|
|
|
p->type = global_string;
|
|
|
|
|
q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL);
|
|
|
|
|
q->entry.string_val = (char *)"fmt";
|
|
|
|
|
q->type = global_string;
|
|
|
|
|
r = make_llnd(fi, SPEC_PAIR, q, p, SMNULL);
|
|
|
|
|
$$ = get_bfnd(fi, PRINT_STAT, SMNULL, LLNULL, r, LLNULL);
|
|
|
|
|
endioctl();
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
inlist: inelt
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST);}
|
|
|
|
|
| inlist COMMA inelt
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST);}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
inelt: lhs
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| LEFTPAR inlist COMMA dospec RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$4->entry.Template.ll_ptr1 = $2;
|
|
|
|
|
$$ = $4;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
outlist: uexpr
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| other
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| out2
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
out2: uexpr COMMA uexpr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| uexpr COMMA other
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| other COMMA uexpr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| other COMMA other
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| out2 COMMA uexpr
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
| out2 COMMA other
|
|
|
|
|
{ $$ = set_ll_list($1, $3, EXPR_LIST); $$->type = $1->type;}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
other: complex_const
|
|
|
|
|
{ $$ = set_ll_list($1, LLNULL, EXPR_LIST);
|
|
|
|
|
$$->type = global_complex; }
|
|
|
|
|
| LEFTPAR expr RIGHTPAR
|
|
|
|
|
{ $$ = set_ll_list($2, LLNULL, EXPR_LIST);
|
|
|
|
|
$$->type = $2->type; }
|
|
|
|
|
| LEFTPAR uexpr COMMA dospec RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$4->entry.Template.ll_ptr1 = $2;
|
|
|
|
|
$$ = set_ll_list($4, LLNULL, EXPR_LIST);
|
|
|
|
|
$$->type = $2->type;
|
|
|
|
|
}
|
|
|
|
|
| LEFTPAR other COMMA dospec RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$4->entry.Template.ll_ptr1 = $2;
|
|
|
|
|
$$ = set_ll_list($4, LLNULL, EXPR_LIST);
|
|
|
|
|
$$->type = $2->type;
|
|
|
|
|
}
|
|
|
|
|
| LEFTPAR out2 COMMA dospec RIGHTPAR
|
|
|
|
|
{
|
|
|
|
|
$4->entry.Template.ll_ptr1 = $2;
|
|
|
|
|
$$ = set_ll_list($4, LLNULL, EXPR_LIST);
|
|
|
|
|
$$->type = $2->type;
|
|
|
|
|
}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
in_ioctl:
|
|
|
|
|
{ inioctl = YES; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
start_ioctl:
|
|
|
|
|
{ startioctl();}
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
* used by I/O statement
|
|
|
|
|
*/
|
|
|
|
|
fexpr: unpar_fexpr
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| LEFTPAR fexpr RIGHTPAR
|
|
|
|
|
{ $$ = $2; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
unpar_fexpr: lhs
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| simple_const
|
|
|
|
|
{ $$ = $1; }
|
|
|
|
|
| fexpr addop fexpr %prec PLUS
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,$2, $1, $3, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
| fexpr ASTER fexpr
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,MULT_OP, $1, $3, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
| fexpr SLASH fexpr
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,DIV_OP, $1, $3, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
| fexpr DASTER fexpr
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,EXP_OP, $1, $3, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
| addop fexpr %prec ASTER
|
|
|
|
|
{
|
|
|
|
|
if($1 == SUBT_OP)
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,SUBT_OP, $2, LLNULL, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
else $$ = $2;
|
|
|
|
|
}
|
|
|
|
|
| fexpr DSLASH fexpr
|
|
|
|
|
{
|
|
|
|
|
$$ = make_llnd(fi,CONCAT_OP, $1, $3, SMNULL);
|
|
|
|
|
set_expr_type($$);
|
|
|
|
|
}
|
|
|
|
|
| IDENTIFIER EQUAL expr
|
|
|
|
|
{ $$ = LLNULL; }
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
cmnt: /* nothing */
|
|
|
|
|
{ comments = cur_comment = CMNULL; }
|
|
|
|
|
| COMMENT
|
|
|
|
|
{ PTR_CMNT p;
|
|
|
|
|
p = make_comment(fi,*commentbuf, HALF);
|
|
|
|
|
if (cur_comment)
|
|
|
|
|
cur_comment->next = p;
|
|
|
|
|
else {
|
|
|
|
|
if ((pred_bfnd->control_parent->variant == LOGIF_NODE) ||(pred_bfnd->control_parent->variant == FORALL_STAT))
|
|
|
|
|
|
|
|
|
|
pred_bfnd->control_parent->entry.Template.cmnt_ptr = p;
|
|
|
|
|
|
|
|
|
|
else last_bfnd->entry.Template.cmnt_ptr = p;
|
|
|
|
|
}
|
|
|
|
|
comments = cur_comment = CMNULL;
|
|
|
|
|
}
|
|
|
|
|
;
|
