This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: Re-implement COMMON and EQUIVALENCE


--- canqun@nudt.edu.cn wrote:
> Hi,
> 
> I re-implemented COMMON and EQUIVALENCE. The
> attached 
> files are:
>    trans-common.c: replace the old one.
>    common.diff.txt: diff file for other part of 
> gfortran.
>    common.f90: testcase.
> 
> To let it work, you must 
> make 'update_alignment_for_field' defind in
> 'gcc/stor-
> layout.c' public.
> 
> Canqun Yang
> 
> 2003-12-02  Canqun Yang  <canqun@nudt.edu.cn>
> 
>  	* trans-common.c: Re-implement COMMON blocks 
> and EQUIVALENCE lists.
>  	* trans-equivalence.c: Remove.
>  	* trans-decl.c (gfc_get_symbol_decl): Update 
> to match.
>  	(gfc_generate_function_code): Ditto.
>  	* trans-array.c (gfc_conv_array_parameter): 
> Ditto. 
> 	* trans.h: Ditto.
>  	* Make-lang.in: Remove 'trans-equvalence.o' 
> from F95_OBJS. Add
>  	'stor-layout.o' to F95_ADDITIONAL_OBJS.
>  	* gfortran.h (struct gfc_equiv): Add 
> field 'used'.
>  	(struct gfc_symbol): Remove dead field.
> 
>  	
> > /* Common block and equivalence list handling
>    Copyright (C) 2000-2003 Free Software Foundation,
> Inc.
>    Contributed by Canqun Yang <canqun@nudt.edu.cn>
> 
> This file is part of GNU G95.
> 
> G95 is free software; you can redistribute it and/or
> modify
> it under the terms of the GNU General Public License
> as published by
> the Free Software Foundation; either version 2, or
> (at your option)
> any later version.
> 
> G95 is distributed in the hope that it will be
> useful,
> but WITHOUT ANY WARRANTY; without even the implied
> warranty of
> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
>  See the
> GNU General Public License for more details.
> 
> You should have received a copy of the GNU General
> Public License
> along with G95; see the file COPYING.  If not, write
> to
> the Free Software Foundation, 59 Temple Place -
> Suite 330,
> Boston, MA 02111-1307, USA.  */     
> 
> /* Transform common blocks.  An integral part of
> this is processing
>    equvalence variables.  Equivalenced variables
> that are not in a
>    common block end up in a private block of their
> own.
> 
>    Each common block or local equivalence list is
> declared as a union.
>    Variables within the block are represented as a
> field within the
>    block with the proper offset. 
>  
>    So if two variables are equivalenced, they just
> point to a common
>    area in memory.
>  
>    Mathematically, laying out an equivalence block
> is equivalent to
>    solving a linear system of equations.  The matrix
> is usually a
>    sparse matrix in which each row contains all zero
> elements except
>    for a +1 and a -1, a sort of a generalized
> Vandermonde matrix.  The
>    matrix is usually block diagonal.  The system can
> be
>    overdetermined, underdetermined or have a unique
> solution.  If the
>    system is inconsistent, the program is not
> standard conforming.
>    The solution vector is integral, since all of the
> pivots are +1 or -1.
>  
>    How we lay out an equivalence block is a little
> less complicated.
>    In an equivalence list with n elements, there are
> n-1 conditions to
>    be satisfied.  The conditions partition the
> variables into what we
>    will call segments.  If A and B are equivalenced
> then A and B are
>    in the same segment.  If B and C are equivalenced
> as well, then A,
>    B and C are in a segment and so on.  Each segment
> is a block of
>    memory that has one or more variables
> equivalenced in some way.  A
>    common block is made up of a series of segments
> that are joined one
>    after the other.  In the linear system, a segment
> is a block
>    diagonal.
>  
>    To lay out a segment we first start with some
> variable and
>    determine its length.  The first variable is
> assumed to start at
>    offset one and extends to however long it is.  We
> then traverse the
>    list of equivalences to find an unused condition
> that involves at
>    least one of the variables currently in the
> segment.
>  
>    Each equivalence condition amounts to the
> condition B+b=C+c where B
>    and C are the offsets of the B and C variables,
> and b and c are
>    constants which are nonzero for array elements,
> substrings or
>    structure components.  So for
>  
>      EQUIVALENCE(B(2), C(3))
>    we have
>      B + 2*size of B's elements = C + 3*size of C's
> elements.
>  
>    If B and C are known we check to see if the
> condition already
>    holds.  If B is known we can solve for C.  Since
> we know the length
>    of C, we can see if the minimum and maximum
> extents of the segment
>    are affected.  Eventually, we make a full pass
> through the
>    equivalence list without finding any new
> conditions and the segment
>    is fully specified.
>  
>    At this point, the segment is added to the
> current common block.
>    Since we know the minimum extent of the segment,
> everything in the
>    segment is translated to its position in the
> common block.  The
>    usual case here is that there are no equivalence
> statements and the
>    common block is series of segments with one
> variable each, which is
>    a diagonal matrix in the matrix formulation.
>  
>    Once all common blocks have been created, the
> list of equivalences
>    is examined for still-unused equivalence
> conditions.  We create a
>    block for each merged equivalence list.  */
> 
> #include "config.h"
> #include "system.h"
> #include "coretypes.h"
> #include "tree.h"
> #include "toplev.h"
> #include "tm.h"
> #include "gfortran.h"
> #include "trans.h"
> #include "trans-types.h"
> 
> extern unsigned int
> update_alignment_for_field (record_layout_info,
> tree, unsigned int);
> 
> typedef struct segment_info
> {
>   gfc_symbol *sym;
>   int offset;
>   int length;
>   tree field; 
>   struct segment_info *next;
> } segment_info;
> 
> static segment_info *current_segment,
> *current_common;
> static int current_length, current_offset;
> static gfc_namespace *gfc_common_ns = NULL;
> 
> #define get_segment_info() gfc_getmem (sizeof
> (segment_info))
> 
> #define BLANK_COMMON_NAME "__BLNK__"
> 
> 
> /* Construct mangled common block name from symbol
> name.  */
> 
> static tree
> gfc_sym_mangled_common_id (gfc_symbol * sym)
> {
>   int has_underscore;
>   char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
> 
>   if (strcmp (sym->name, BLANK_COMMON_NAME) == 0)
>     return get_identifier (sym->name);
>   if (gfc_option.flag_underscoring)
>     {
>       has_underscore = strchr (sym->name, '_') != 0;
>       if (gfc_option.flag_second_underscore &&
> has_underscore)
>         snprintf (name, sizeof name, "%s__",
> sym->name);
>       else
>         snprintf (name, sizeof name, "%s_",
> sym->name);
>       return get_identifier (name);
>     }
>   else
>     return get_identifier (sym->name);
> }
> 
> 
> 
=== message truncated ===> diff -c3p
fortran.old/ChangeLog fortran/ChangeLog
> *** fortran.old/ChangeLog	2003-12-03
> 21:33:07.000000000 +0800
> --- fortran/ChangeLog	2003-12-03 15:02:46.000000000
> +0800
> ***************
> *** 1,3 ****
> --- 1,16 ----
> + 2003-12-02  Canqun Yang  <canqun@nudt.edu.cn>
> + 
> + 	* trans-common.c: Re-implement COMMON blocks and
> EQUIVALENCE lists.
> + 	* trans-equivalence.c: Remove.
> + 	* trans-decl.c (gfc_get_symbol_decl): Update to
> match.
> + 	(gfc_generate_function_code): Ditto.
> + 	* trans-array.c (gfc_conv_array_parameter):
> Ditto. 
> + 	* Make-lang.in: Remove 'trans-equvalence.o' from
> F95_OBJS. Add
> + 	'stor-layout.o' to F95_ADDITIONAL_OBJS.
> + 	* gfortran.h (struct gfc_equiv): Add field
> 'used'.
> + 	(struct gfc_symbol): Remove dead field.
> + 	* trans.h: Update to match.
> + 	
>   2003-12-01  Feng Wang  <fengwang@nudt.edu.cn>
>   
>   	* io.c (gfc_match_format): Check for missing
> format label.
> 
> diff -c3p fortran.old/gfortran.h fortran/gfortran.h
> *** fortran.old/gfortran.h	2003-12-03
> 21:33:08.000000000 +0800
> --- fortran/gfortran.h	2003-12-02 20:07:46.000000000
> +0800
> *************** typedef struct gfc_symbol
> *** 650,667 ****
>     unsigned mark:1, new:1;
>     int refs;
>     struct gfc_namespace *ns;	/* namespace
> containing this symbol */
> ! 
> !   /* To hold the storage layout for a COMMON
> variable or an EQUIVALENCE
> !      object.  */
> !   tree addr_base;
> !   tree addr_offset;
> ! 
> !   /* Information for an EQUIVALENCE object */
> !   struct gfc_symbol *equiv_ring;
> !   HOST_WIDE_INT equiv_offset;
> ! 
>     tree backend_decl;
> - 
>   }
>   gfc_symbol;
>   
> --- 650,657 ----
>     unsigned mark:1, new:1;
>     int refs;
>     struct gfc_namespace *ns;	/* namespace
> containing this symbol */
> !   
>     tree backend_decl;
>   }
>   gfc_symbol;
>   
> *************** typedef struct gfc_equiv
> *** 994,999 ****
> --- 984,990 ----
>   {
>     struct gfc_equiv *next, *eq;
>     gfc_expr *expr;
> +   int used;
>   }
>   gfc_equiv;
>   
> diff -c3p fortran.old/Make-lang.in
> fortran/Make-lang.in
> *** fortran.old/Make-lang.in	2003-12-03
> 21:33:07.000000000 +0800
> --- fortran/Make-lang.in	2003-12-02
> 19:57:27.000000000 +0800
> *************** F95_OBJS = $(F95_PARSER_OBJS) \
> *** 75,81 ****
>       fortran/trans-types.o fortran/trans-const.o
> fortran/trans-expr.o \
>       fortran/trans-stmt.o fortran/trans-io.o
> fortran/trans-array.o \
>       fortran/trans-intrinsic.o fortran/dependency.o
> fortran/trans-common.o \
> !     fortran/trans-equivalence.o fortran/data.o
>   
>   # FIXME:
>   # We rely on c-semantics to expand from GIMPLE to
> RTL.
> --- 75,81 ----
>       fortran/trans-types.o fortran/trans-const.o
> fortran/trans-expr.o \
>       fortran/trans-stmt.o fortran/trans-io.o
> fortran/trans-array.o \
>       fortran/trans-intrinsic.o fortran/dependency.o
> fortran/trans-common.o \
> !     fortran/data.o
>   
>   # FIXME:
>   # We rely on c-semantics to expand from GIMPLE to
> RTL.
> *************** F95_OBJS = $(F95_PARSER_OBJS) \
> *** 83,89 ****
>   F95_ADDITIONAL_OBJS = \
>   	tree-cfg.o tree-dfa.o tree-optimize.o
> tree-simple.o \
>   	tree-ssa.o tree-ssa-ccp.o tree-ssa-dce.o \
> ! 	tree-alias-common.o tree-alias-type.o gimplify.o
>   
>   # GFORTRAN uses GMP for its internal arithmetics.
>   F95_LIBS = $(GMPLIBS) $(LIBS)
> --- 83,89 ----
>   F95_ADDITIONAL_OBJS = \
>   	tree-cfg.o tree-dfa.o tree-optimize.o
> tree-simple.o \
>   	tree-ssa.o tree-ssa-ccp.o tree-ssa-dce.o \
> ! 	tree-alias-common.o tree-alias-type.o gimplify.o
> stor-layout.o
>   
>   # GFORTRAN uses GMP for its internal arithmetics.
>   F95_LIBS = $(GMPLIBS) $(LIBS)
> 
> diff -c3p fortran.old/trans-array.c
> fortran/trans-array.c
> *** fortran.old/trans-array.c	2003-12-03
> 21:33:08.000000000 +0800
> --- fortran/trans-array.c	2003-12-03
> 09:53:05.000000000 +0800
> *************** gfc_conv_array_parameter (gfc_se *
> se, g
> *** 3673,3679 ****
>     tree stmt;
>     gfc_symbol *sym;
>     stmtblock_t block;
> ! 
>     /* Passing address of the array if it is not
> pointer or assumed-shape.  */
>     if (expr->expr_type == EXPR_VARIABLE
>          && expr->ref->u.ar.type == AR_FULL && g77)
> --- 3673,3679 ----
>     tree stmt;
>     gfc_symbol *sym;
>     stmtblock_t block;
> !   
>     /* Passing address of the array if it is not
> pointer or assumed-shape.  */
>     if (expr->expr_type == EXPR_VARIABLE
>          && expr->ref->u.ar.type == AR_FULL && g77)
> *************** gfc_conv_array_parameter (gfc_se *
> se, g
> *** 3681,3687 ****
>         sym = expr->symtree->n.sym;
>         tmp = gfc_get_symbol_decl (sym);
>         if (!sym->attr.pointer && sym->as->type !=
> AS_ASSUMED_SHAPE 
> !           && !sym->attr.allocatable &&
> !sym->attr.in_common)
>           {
>             if (!sym->attr.dummy)
>   	    se->expr = build1 (ADDR_EXPR,
> --- 3681,3687 ----
>         sym = expr->symtree->n.sym;
>         tmp = gfc_get_symbol_decl (sym);
>         if (!sym->attr.pointer && sym->as->type !=
> AS_ASSUMED_SHAPE 
> !           && !sym->attr.allocatable)
>           {
>             if (!sym->attr.dummy)
>   	    se->expr = build1 (ADDR_EXPR,
> *************** gfc_conv_array_parameter (gfc_se *
> se, g
> *** 3696,3708 ****
>             se->expr = gfc_conv_array_data (tmp);
>             return;
>           }
> -       if (sym->attr.in_common)
> -         {
> -           se->expr = TREE_OPERAND (tmp, 0);
> -           return;
> -         }
>       }
> ! 
>     se->want_pointer = 1;
>     gfc_conv_expr_descriptor (se, expr, ss);
>   
> --- 3696,3703 ----
>             se->expr = gfc_conv_array_data (tmp);
>             return;
>           }
>       }
> !   
>     se->want_pointer = 1;
>     gfc_conv_expr_descriptor (se, expr, ss);
> 
=== message truncated ===> ! Program to test COMMON
and EQUIVALENCE.
> program common
>    real (kind=8) a(8)
>    real (kind=8) b(5), c(5)
>    common /com1/b,c
>    equivalence (a(1), b(2))
>    b = 100
>    c = 200
>    call common_pass
>    call common_par (a, b,c)
>    call global_equiv
>    call local_equiv
> end
> 
> ! Use common block to pass values
> subroutine common_pass
>    real (kind=8) a(8)
>    real (kind=8) b(5), c(5)
>    common /com1/b,c
>    equivalence (a(1), b(2))
>    if (any (a .ne.
> (/100,100,100,100,200,200,200,200/))) call abort
> end subroutine
> 
> ! Common variables as argument
> subroutine common_par (a, b, c)
>    real (kind=8) a(8), b(5), c(5)
>    if (any (a .ne.
> (/100,100,100,100,200,200,200,200/))) call abort
>    if (any (b .ne. (/100,100,100,100,100/))) call
> abort
>    if (any (c .ne. (/200,200,200,200,200/))) call
> abort
> end subroutine
> 
> ! Global equivalence
> subroutine global_equiv
>    real (kind=8) a(8), b(5), c(5), x(8), y(4), z(4)
>    common /com2/b, c, y, z
>    equivalence (a(1), b(2))
>    equivalence (x(4), y(1))
>    b = 100
>    c = 200
>    y = 300
>    z = 400
>    if (any (a .ne.
> (/100,100,100,100,200,200,200,200/))) call abort
>    if (any (x .ne.
> (/200,200,200,300,300,300,300,400/))) call abort 
> end
> 
> ! Local equivalence
> subroutine local_equiv
>   real (kind=8) a(8), b(10)
>   equivalence (a(1), b(3))
>   b(1:5) = 100
>   b(6:10) = 200
>   if (any (a .ne.
> (/100,100,100,200,200,200,200,200/))) call abort
> end subroutine
> 


__________________________________
Do you Yahoo!?
Free Pop-Up Blocker - Get it now
http://companion.yahoo.com/


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]