From patchwork Tue Jul 13 19:49:05 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Nathan Froyd X-Patchwork-Id: 58812 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id C48E6B6EEE for ; Wed, 14 Jul 2010 05:49:19 +1000 (EST) Received: (qmail 27032 invoked by alias); 13 Jul 2010 19:49:16 -0000 Received: (qmail 26967 invoked by uid 22791); 13 Jul 2010 19:49:13 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL, BAYES_05, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mail.codesourcery.com (HELO mail.codesourcery.com) (38.113.113.100) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 13 Jul 2010 19:49:07 +0000 Received: (qmail 31326 invoked from network); 13 Jul 2010 19:49:05 -0000 Received: from unknown (HELO localhost) (froydnj@127.0.0.2) by mail.codesourcery.com with ESMTPA; 13 Jul 2010 19:49:05 -0000 Date: Tue, 13 Jul 2010 12:49:05 -0700 From: Nathan Froyd To: gcc-patches@gcc.gnu.org Subject: [PATCH] don't use chainon when building VMS descriptors in Ada FE Message-ID: <20100713194905.GK12333@codesourcery.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.17+20080114 (2008-01-14) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch gives the Ada FE the same treatment the Fortran and ObjC frontends have recently undergone: removing chainon when building fields lists for TYPE_FIELDS. This change eliminates quadratic behavior and makes a future refactoring of TREE_CHAIN easier. Tested on x86_64-unknown-linux-gnu. I don't have a VMS machine to test the changes on, so the goodness of the changes is not exactly confirmed. At least it builds, right? OK to commit? -Nathan * gcc-interface/utils.c (make_descriptor_field): Add tree ** parameter. (build_vms_descriptor32): Adjust calls to it for new parameter. (build_vms_descriptor): Likewise. Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 162147) +++ gcc-interface/utils.c (working copy) @@ -198,7 +198,7 @@ static tree split_plus (tree, tree *); static tree float_type_for_precision (int, enum machine_mode); static tree convert_to_fat_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree); -static tree make_descriptor_field (const char *,tree, tree, tree); +static tree make_descriptor_field (const char *,tree, tree, tree, tree **); static bool potential_alignment_gap (tree, tree, tree); static void process_attributes (tree, struct attrib *); @@ -2291,7 +2291,7 @@ build_vms_descriptor32 (tree type, Mecha { tree record_type = make_node (RECORD_TYPE); tree pointer32_type; - tree field_list = 0; + tree field_list = NULL_TREE; int klass; int dtype = 0; tree inner_type; @@ -2299,6 +2299,7 @@ build_vms_descriptor32 (tree type, Mecha int i; tree *idx_arr; tree tem; + tree *field_chain = NULL; /* If TYPE is an unconstrained array, use the underlying array type. */ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) @@ -2425,34 +2426,27 @@ build_vms_descriptor32 (tree type, Mecha /* Make the type for a descriptor for VMS. The first four fields are the same for all types. */ - field_list - = chainon (field_list, - make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1), - record_type, - size_in_bytes - ((mech == By_Descriptor_A - || mech == By_Short_Descriptor_A) - ? inner_type : type))); - field_list - = chainon (field_list, - make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1), - record_type, size_int (dtype))); - field_list - = chainon (field_list, - make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), - record_type, size_int (klass))); + field_list = + make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1), + record_type, + size_in_bytes + ((mech == By_Descriptor_A + || mech == By_Short_Descriptor_A) + ? inner_type : type), &field_chain); + make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1), + record_type, size_int (dtype), &field_chain); + make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), + record_type, size_int (klass), &field_chain); /* Of course this will crash at run time if the address space is not within the low 32 bits, but there is nothing else we can do. */ pointer32_type = build_pointer_type_for_mode (type, SImode, false); - field_list - = chainon (field_list, - make_descriptor_field ("POINTER", pointer32_type, record_type, - build_unary_op (ADDR_EXPR, - pointer32_type, - build0 (PLACEHOLDER_EXPR, - type)))); + make_descriptor_field ("POINTER", pointer32_type, record_type, + build_unary_op (ADDR_EXPR, + pointer32_type, + build0 (PLACEHOLDER_EXPR, + type)), &field_chain); switch (mech) { @@ -2464,59 +2458,41 @@ build_vms_descriptor32 (tree type, Mecha case By_Descriptor_SB: case By_Short_Descriptor_SB: - field_list - = chainon (field_list, - make_descriptor_field - ("SB_L1", gnat_type_for_size (32, 1), record_type, - TREE_CODE (type) == ARRAY_TYPE - ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node)); - field_list - = chainon (field_list, - make_descriptor_field - ("SB_U1", gnat_type_for_size (32, 1), record_type, - TREE_CODE (type) == ARRAY_TYPE - ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) : size_zero_node)); + make_descriptor_field ("SB_L1", gnat_type_for_size (32, 1), record_type, + (TREE_CODE (type) == ARRAY_TYPE + ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) + : size_zero_node), &field_chain); + make_descriptor_field ("SB_U1", gnat_type_for_size (32, 1), record_type, + (TREE_CODE (type) == ARRAY_TYPE + ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) + : size_zero_node), &field_chain); break; case By_Descriptor_A: case By_Short_Descriptor_A: case By_Descriptor_NCA: case By_Short_Descriptor_NCA: - field_list = chainon (field_list, - make_descriptor_field ("SCALE", - gnat_type_for_size (8, 1), - record_type, - size_zero_node)); - - field_list = chainon (field_list, - make_descriptor_field ("DIGITS", - gnat_type_for_size (8, 1), - record_type, - size_zero_node)); - - field_list - = chainon (field_list, - make_descriptor_field - ("AFLAGS", gnat_type_for_size (8, 1), record_type, - size_int ((mech == By_Descriptor_NCA || - mech == By_Short_Descriptor_NCA) - ? 0 - /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */ - : (TREE_CODE (type) == ARRAY_TYPE - && TYPE_CONVENTION_FORTRAN_P (type) - ? 224 : 192)))); - - field_list = chainon (field_list, - make_descriptor_field ("DIMCT", - gnat_type_for_size (8, 1), - record_type, - size_int (ndim))); - - field_list = chainon (field_list, - make_descriptor_field ("ARSIZE", - gnat_type_for_size (32, 1), - record_type, - size_in_bytes (type))); + make_descriptor_field ("SCALE", gnat_type_for_size (8, 1), + record_type, size_zero_node, &field_chain); + + make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1), + record_type, size_zero_node, &field_chain); + + make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), record_type, + size_int ((mech == By_Descriptor_NCA || + mech == By_Short_Descriptor_NCA) + ? 0 + /* Set FL_COLUMN, FL_COEFF, and + FL_BOUNDS. */ + : (TREE_CODE (type) == ARRAY_TYPE + && TYPE_CONVENTION_FORTRAN_P (type) + ? 224 : 192)), &field_chain); + + make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1), + record_type, size_int (ndim), &field_chain); + + make_descriptor_field ("ARSIZE", gnat_type_for_size (32, 1), + record_type, size_in_bytes (type), &field_chain); /* Now build a pointer to the 0,0,0... element. */ tem = build0 (PLACEHOLDER_EXPR, type); @@ -2526,16 +2502,9 @@ build_vms_descriptor32 (tree type, Mecha convert (TYPE_DOMAIN (inner_type), size_zero_node), NULL_TREE, NULL_TREE); - field_list - = chainon (field_list, - make_descriptor_field - ("A0", - build_pointer_type_for_mode (inner_type, SImode, false), - record_type, - build1 (ADDR_EXPR, - build_pointer_type_for_mode (inner_type, SImode, - false), - tem))); + make_descriptor_field ("A0", pointer32_type, record_type, + build1 (ADDR_EXPR, pointer32_type, tem), + &field_chain); /* Next come the addressing coefficients. */ tem = size_one_node; @@ -2553,11 +2522,8 @@ build_vms_descriptor32 (tree type, Mecha fname[0] = ((mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA) ? 'S' : 'M'); fname[1] = '0' + i, fname[2] = 0; - field_list - = chainon (field_list, - make_descriptor_field (fname, - gnat_type_for_size (32, 1), - record_type, idx_length)); + make_descriptor_field (fname, gnat_type_for_size (32, 1), + record_type, idx_length, &field_chain); if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA) tem = idx_length; @@ -2569,18 +2535,14 @@ build_vms_descriptor32 (tree type, Mecha char fname[3]; fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0; - field_list - = chainon (field_list, - make_descriptor_field - (fname, gnat_type_for_size (32, 1), record_type, - TYPE_MIN_VALUE (idx_arr[i]))); + make_descriptor_field (fname, gnat_type_for_size (32, 1), + record_type, TYPE_MIN_VALUE (idx_arr[i]), + &field_chain); fname[0] = 'U'; - field_list - = chainon (field_list, - make_descriptor_field - (fname, gnat_type_for_size (32, 1), record_type, - TYPE_MAX_VALUE (idx_arr[i]))); + make_descriptor_field (fname, gnat_type_for_size (32, 1), + record_type, TYPE_MAX_VALUE (idx_arr[i]), + &field_chain); } break; @@ -2605,7 +2567,7 @@ build_vms_descriptor (tree type, Mechani { tree record64_type = make_node (RECORD_TYPE); tree pointer64_type; - tree field_list64 = 0; + tree field_list64 = NULL_TREE; int klass; int dtype = 0; tree inner_type; @@ -2613,6 +2575,7 @@ build_vms_descriptor (tree type, Mechani int i; tree *idx_arr; tree tem; + tree *field_chain64 = NULL; /* If TYPE is an unconstrained array, use the underlying array type. */ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) @@ -2735,38 +2698,25 @@ build_vms_descriptor (tree type, Mechani /* Make the type for a 64-bit descriptor for VMS. The first six fields are the same for all types. */ field_list64 - = chainon (field_list64, - make_descriptor_field ("MBO", gnat_type_for_size (16, 1), - record64_type, size_int (1))); - field_list64 - = chainon (field_list64, - make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1), - record64_type, size_int (dtype))); - field_list64 - = chainon (field_list64, - make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), - record64_type, size_int (klass))); - field_list64 - = chainon (field_list64, - make_descriptor_field ("MBMO", gnat_type_for_size (32, 1), - record64_type, ssize_int (-1))); - field_list64 - = chainon (field_list64, - make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1), - record64_type, - size_in_bytes (mech == By_Descriptor_A - ? inner_type : type))); + = make_descriptor_field ("MBO", gnat_type_for_size (16, 1), + record64_type, size_int (1), &field_chain64); + make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1), + record64_type, size_int (dtype), &field_chain64); + make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), + record64_type, size_int (klass), &field_chain64); + make_descriptor_field ("MBMO", gnat_type_for_size (32, 1), + record64_type, ssize_int (-1), &field_chain64); + make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1), record64_type, + size_in_bytes (mech == By_Descriptor_A + ? inner_type : type), &field_chain64); pointer64_type = build_pointer_type_for_mode (type, DImode, false); - field_list64 - = chainon (field_list64, - make_descriptor_field ("POINTER", pointer64_type, - record64_type, - build_unary_op (ADDR_EXPR, - pointer64_type, - build0 (PLACEHOLDER_EXPR, - type)))); + make_descriptor_field ("POINTER", pointer64_type, record64_type, + build_unary_op (ADDR_EXPR, + pointer64_type, + build0 (PLACEHOLDER_EXPR, + type)), &field_chain64); switch (mech) { @@ -2775,61 +2725,44 @@ build_vms_descriptor (tree type, Mechani break; case By_Descriptor_SB: - field_list64 - = chainon (field_list64, - make_descriptor_field - ("SB_L1", gnat_type_for_size (64, 1), record64_type, - TREE_CODE (type) == ARRAY_TYPE - ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node)); - field_list64 - = chainon (field_list64, - make_descriptor_field - ("SB_U1", gnat_type_for_size (64, 1), record64_type, - TREE_CODE (type) == ARRAY_TYPE - ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) : size_zero_node)); + make_descriptor_field ("SB_L1", gnat_type_for_size (64, 1), + record64_type, + (TREE_CODE (type) == ARRAY_TYPE + ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) + : size_zero_node), &field_chain64); + make_descriptor_field ("SB_U1", gnat_type_for_size (64, 1), + record64_type, + (TREE_CODE (type) == ARRAY_TYPE + ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) + : size_zero_node), &field_chain64); break; case By_Descriptor_A: case By_Descriptor_NCA: - field_list64 = chainon (field_list64, - make_descriptor_field ("SCALE", - gnat_type_for_size (8, 1), - record64_type, - size_zero_node)); - - field_list64 = chainon (field_list64, - make_descriptor_field ("DIGITS", - gnat_type_for_size (8, 1), - record64_type, - size_zero_node)); - - field_list64 - = chainon (field_list64, - make_descriptor_field - ("AFLAGS", gnat_type_for_size (8, 1), record64_type, - size_int (mech == By_Descriptor_NCA - ? 0 - /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */ - : (TREE_CODE (type) == ARRAY_TYPE - && TYPE_CONVENTION_FORTRAN_P (type) - ? 224 : 192)))); - - field_list64 = chainon (field_list64, - make_descriptor_field ("DIMCT", - gnat_type_for_size (8, 1), - record64_type, - size_int (ndim))); - - field_list64 = chainon (field_list64, - make_descriptor_field ("MBZ", - gnat_type_for_size (32, 1), - record64_type, - size_int (0))); - field_list64 = chainon (field_list64, - make_descriptor_field ("ARSIZE", - gnat_type_for_size (64, 1), - record64_type, - size_in_bytes (type))); + make_descriptor_field ("SCALE", gnat_type_for_size (8, 1), + record64_type, size_zero_node, &field_chain64); + + make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1), + record64_type, size_zero_node, &field_chain64); + + make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), + record64_type, + size_int (mech == By_Descriptor_NCA + ? 0 + /* Set FL_COLUMN, FL_COEFF, and + FL_BOUNDS. */ + : (TREE_CODE (type) == ARRAY_TYPE + && TYPE_CONVENTION_FORTRAN_P (type) + ? 224 : 192)), &field_chain64); + + make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1), + record64_type, size_int (ndim), &field_chain64); + + make_descriptor_field ("MBZ", gnat_type_for_size (32, 1), + record64_type, size_int (0), &field_chain64); + make_descriptor_field ("ARSIZE", gnat_type_for_size (64, 1), + record64_type, size_in_bytes (type), + &field_chain64); /* Now build a pointer to the 0,0,0... element. */ tem = build0 (PLACEHOLDER_EXPR, type); @@ -2839,16 +2772,9 @@ build_vms_descriptor (tree type, Mechani convert (TYPE_DOMAIN (inner_type), size_zero_node), NULL_TREE, NULL_TREE); - field_list64 - = chainon (field_list64, - make_descriptor_field - ("A0", - build_pointer_type_for_mode (inner_type, DImode, false), - record64_type, - build1 (ADDR_EXPR, - build_pointer_type_for_mode (inner_type, DImode, - false), - tem))); + make_descriptor_field ("A0", pointer64_type, record64_type, + build1 (ADDR_EXPR, pointer64_type, tem), + &field_chain64); /* Next come the addressing coefficients. */ tem = size_one_node; @@ -2865,11 +2791,8 @@ build_vms_descriptor (tree type, Mechani fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M'); fname[1] = '0' + i, fname[2] = 0; - field_list64 - = chainon (field_list64, - make_descriptor_field (fname, - gnat_type_for_size (64, 1), - record64_type, idx_length)); + make_descriptor_field (fname, gnat_type_for_size (64, 1), + record64_type, idx_length, &field_chain64); if (mech == By_Descriptor_NCA) tem = idx_length; @@ -2881,18 +2804,14 @@ build_vms_descriptor (tree type, Mechani char fname[3]; fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0; - field_list64 - = chainon (field_list64, - make_descriptor_field - (fname, gnat_type_for_size (64, 1), record64_type, - TYPE_MIN_VALUE (idx_arr[i]))); + make_descriptor_field (fname, gnat_type_for_size (64, 1), + record64_type, TYPE_MIN_VALUE (idx_arr[i]), + &field_chain64); fname[0] = 'U'; - field_list64 - = chainon (field_list64, - make_descriptor_field - (fname, gnat_type_for_size (64, 1), record64_type, - TYPE_MAX_VALUE (idx_arr[i]))); + make_descriptor_field (fname, gnat_type_for_size (64, 1), + record64_type, TYPE_MAX_VALUE (idx_arr[i]), + &field_chain64); } break; @@ -2909,12 +2828,16 @@ build_vms_descriptor (tree type, Mechani static tree make_descriptor_field (const char *name, tree type, - tree rec_type, tree initial) + tree rec_type, tree initial, tree **chain) { tree field = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE, NULL_TREE, 0, 0); + if (*chain != NULL) + **chain = field; + *chain = &TREE_CHAIN (field); + DECL_INITIAL (field) = initial; return field; }