From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x434.google.com (mail-wr1-x434.google.com [IPv6:2a00:1450:4864:20::434]) by sourceware.org (Postfix) with ESMTPS id 9EC6C384A022 for ; Thu, 13 Aug 2020 12:58:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 9EC6C384A022 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=embecosm.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=andrew.burgess@embecosm.com Received: by mail-wr1-x434.google.com with SMTP id f12so5168437wru.13 for ; Thu, 13 Aug 2020 05:58:56 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=yzMjat1zk8jbIo0gu/sexai+npThemLv0UVqR/cIcRw=; b=etKkWFbFcL1trqgaHdAz9karRZojQylX4MKPV9rSuckm9HbOOXYalc4vAOnnCVJ48O AzMdXuVzqhYC3NKx8XaRnjajhHS45BeFRAjq8DxKP28LJeLGIitzEbx+TZtcCiMeCx0+ Ka93InCZRiJ6Fm+qKr6PnIsUpq6DCrwMzQmYc9Ebma8oGq+trcmoYLJwHQM9QhqPp2Ia JBrBeJv6tA0bPvhtxIPLlALAPZjBdIALKYIp46Hb2Bee8jSucDVjmwg7ERJ2GWDKNiqJ W7E8i90lT0TdiTHQPPy2Nx09cLIdfjiQ641OgoPW61jU1Lv4mjhWkgglfUF7oC2fXXJ6 bqmQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=yzMjat1zk8jbIo0gu/sexai+npThemLv0UVqR/cIcRw=; b=B6sTAJex9Lt/8EXCiSl7/C1Iy6RtRfUIszsI+MaoU4n3KB4cMyIIyrV9W8PxTphVog NeavZvBUHzME8GhxaEORXSP1P0naxOfaO57e3DEBtf2DBGqriOgpEnuuL0fK6OepUqV0 l6lYUiue0ayaOcZSmxG+QTK81nEM4pNZKwXU4d22bFBQ7aczZR8n5uhpQUxiSr1t0ezT EwArHmtZNrEkMoQIILRdvmKqgoS1HKBeXNcHeO0EJdRUuifkNTggQQe7oLNY35AtpeCM BCheFHgVcYSUc8QkGGb9TFr5VQJYT9TN8d4xMmyNAZd5fxkeUcLfWvvztQ52ly+SUxcj sfFg== X-Gm-Message-State: AOAM5318shNYjf6r2HjTeXNkcQ6Sh3WA7h4d9CkYaMwc2gBoopeEjpQB jvRk1y/BImVzRegdmmtd27oUHEoWSXM= X-Google-Smtp-Source: ABdhPJzJb+M2nUR6DXvv9kdMCOzP/WjXqiEp0fdUSOB4oDgLOjhiblYZMalSDP9gD5Y7lrvKVlNnng== X-Received: by 2002:adf:f247:: with SMTP id b7mr4231485wrp.128.1597323535212; Thu, 13 Aug 2020 05:58:55 -0700 (PDT) Received: from localhost (host86-186-80-213.range86-186.btcentralplus.com. [86.186.80.213]) by smtp.gmail.com with ESMTPSA id v12sm10137512wri.47.2020.08.13.05.58.54 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 13 Aug 2020 05:58:54 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Subject: [PATCH 3/8] gdb/fortran: Clean up array/string expression evaluation Date: Thu, 13 Aug 2020 13:58:40 +0100 Message-Id: X-Mailer: git-send-email 2.25.4 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 13 Aug 2020 12:58:58 -0000 In preparation for adding Fortan array stride expression support, this is the first phase of some clean up to the expression evaluation for Fortran arrays and strings. The current code is split into two blocks, linked, weirdly, with a goto. After this commit all the code is moved to its own function, and arrays and strings are now handled using the same code; this will be useful later when I want to add array stride support where strings will want to be treated just like arrays. For now the new function is added as a static within eval.c, even though the function is Fortran only. A following commit will remove some of the Fortran specific code from eval.c into one of the Fortran specific files, including this new function. There should be no user visible changes after this commit. gdb/ChangeLog: * eval.c (fortran_value_subarray): New function, content is taken from... (evaluate_subexp_standard): ...here, in two places. Now arrays and strings both call the new function. (calc_f77_array_dims): Add header comment, handle strings. --- gdb/ChangeLog | 8 +++ gdb/eval.c | 136 +++++++++++++++++++++++++------------------------- 2 files changed, 75 insertions(+), 69 deletions(-) diff --git a/gdb/eval.c b/gdb/eval.c index c62c35f3183..59ba1b69e7c 100644 --- a/gdb/eval.c +++ b/gdb/eval.c @@ -1260,6 +1260,67 @@ is_integral_or_integral_reference (struct type *type) && is_integral_type (TYPE_TARGET_TYPE (type))); } +/* Called from evaluate_subexp_standard to perform array indexing, and + sub-range extraction, for Fortran. As well as arrays this function + also handles strings as they can be treated like arrays of characters. + ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are + as for evaluate_subexp_standard, and NARGS is the number of arguments + in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ + +static struct value * +fortran_value_subarray (struct value *array, struct expression *exp, + int *pos, int nargs, enum noside noside) +{ + if (exp->elts[*pos].opcode == OP_RANGE) + return value_f90_subarray (array, exp, pos, noside); + + if (noside == EVAL_SKIP) + { + skip_undetermined_arglist (nargs, exp, pos, noside); + /* Return the dummy value with the correct type. */ + return array; + } + + LONGEST subscript_array[MAX_FORTRAN_DIMS]; + int ndimensions = 1; + struct type *type = check_typedef (value_type (array)); + + if (nargs > MAX_FORTRAN_DIMS) + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); + + ndimensions = calc_f77_array_dims (type); + + if (nargs != ndimensions) + error (_("Wrong number of subscripts")); + + gdb_assert (nargs > 0); + + /* Now that we know we have a legal array subscript expression let us + actually find out where this element exists in the array. */ + + /* Take array indices left to right. */ + for (int i = 0; i < nargs; i++) + { + /* Evaluate each subscript; it must be a legal integer in F77. */ + value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); + + /* Fill in the subscript array. */ + subscript_array[i] = value_as_long (arg2); + } + + /* Internal type of array is arranged right to left. */ + for (int i = nargs; i > 0; i--) + { + struct type *array_type = check_typedef (value_type (array)); + LONGEST index = subscript_array[i - 1]; + + array = value_subscripted_rvalue (array, index, + f77_get_lowerbound (array_type)); + } + + return array; +} + struct value * evaluate_subexp_standard (struct type *expect_type, struct expression *exp, int *pos, @@ -1954,33 +2015,8 @@ evaluate_subexp_standard (struct type *expect_type, switch (code) { case TYPE_CODE_ARRAY: - if (exp->elts[*pos].opcode == OP_RANGE) - return value_f90_subarray (arg1, exp, pos, noside); - else - { - if (noside == EVAL_SKIP) - { - skip_undetermined_arglist (nargs, exp, pos, noside); - /* Return the dummy value with the correct type. */ - return arg1; - } - goto multi_f77_subscript; - } - case TYPE_CODE_STRING: - if (exp->elts[*pos].opcode == OP_RANGE) - return value_f90_subarray (arg1, exp, pos, noside); - else - { - if (noside == EVAL_SKIP) - { - skip_undetermined_arglist (nargs, exp, pos, noside); - /* Return the dummy value with the correct type. */ - return arg1; - } - arg2 = evaluate_subexp_with_coercion (exp, pos, noside); - return value_subscript (arg1, value_as_long (arg2)); - } + return fortran_value_subarray (arg1, exp, pos, nargs, noside); case TYPE_CODE_PTR: case TYPE_CODE_FUNC: @@ -2400,49 +2436,6 @@ evaluate_subexp_standard (struct type *expect_type, } return (arg1); - multi_f77_subscript: - { - LONGEST subscript_array[MAX_FORTRAN_DIMS]; - int ndimensions = 1, i; - struct value *array = arg1; - - if (nargs > MAX_FORTRAN_DIMS) - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); - - ndimensions = calc_f77_array_dims (type); - - if (nargs != ndimensions) - error (_("Wrong number of subscripts")); - - gdb_assert (nargs > 0); - - /* Now that we know we have a legal array subscript expression - let us actually find out where this element exists in the array. */ - - /* Take array indices left to right. */ - for (i = 0; i < nargs; i++) - { - /* Evaluate each subscript; it must be a legal integer in F77. */ - arg2 = evaluate_subexp_with_coercion (exp, pos, noside); - - /* Fill in the subscript array. */ - - subscript_array[i] = value_as_long (arg2); - } - - /* Internal type of array is arranged right to left. */ - for (i = nargs; i > 0; i--) - { - struct type *array_type = check_typedef (value_type (array)); - LONGEST index = subscript_array[i - 1]; - - array = value_subscripted_rvalue (array, index, - f77_get_lowerbound (array_type)); - } - - return array; - } - case BINOP_LOGICAL_AND: arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); if (noside == EVAL_SKIP) @@ -3356,12 +3349,17 @@ parse_and_eval_type (char *p, int length) return expr->elts[1].type; } +/* Return the number of dimensions for a Fortran array or string. */ + int calc_f77_array_dims (struct type *array_type) { int ndimen = 1; struct type *tmp_type; + if ((array_type->code () == TYPE_CODE_STRING)) + return 1; + if ((array_type->code () != TYPE_CODE_ARRAY)) error (_("Can't get dimensions for a non-array type")); -- 2.25.4