From patchwork Thu Sep 26 03:08:06 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tomasz Kulasek X-Patchwork-Id: 34676 Received: (qmail 111341 invoked by alias); 26 Sep 2019 03:08:18 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 111333 invoked by uid 89); 26 Sep 2019 03:08:18 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.9 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=12486, START X-HELO: mail-lf1-f68.google.com Received: from mail-lf1-f68.google.com (HELO mail-lf1-f68.google.com) (209.85.167.68) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 26 Sep 2019 03:08:16 +0000 Received: by mail-lf1-f68.google.com with SMTP id u28so515324lfc.5 for ; Wed, 25 Sep 2019 20:08:16 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id; bh=aXZCulIiTdW2f5sU9ipJwWFB251p3YnWGotQ2Runn8E=; b=nVf47WK3QigrZvd040mZXUiphVbbpbr0I4yTOzN5YLgZbQoCGiTeoNI1x8wm07XIul AEXCa6qMU8IlR5SlkhjhaN5VWtSKUPsSr4HoTU/d4FwoZxCLBLYH9ZnnBbzB7kzTz+Ob U0toA8R3mGCbESMptNPUdWcNWzCjHWF5Vjl/XHbd9Di10GOjd4orQm0VGE9Hcqjj2CUY Jo1V3H+tuH4Y7sou6SNu7IxY5wXLki2CgW290+gakumc+MSPeMuZlryMTeZa7MDAeLDs yq6u9umMgCDZqRWeDfsmnKHYLqu8zA4gPjHRBVSwaKNl5B97bvLefZla1WuAxTOpi21T sZxA== Return-Path: Received: from localhost.localdomain ([5.174.197.246]) by smtp.gmail.com with ESMTPSA id 134sm213082lfk.70.2019.09.25.20.08.13 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 25 Sep 2019 20:08:14 -0700 (PDT) From: Tomasz Kulasek To: gdb-patches@sourceware.org Cc: Abhishek Aggarwal , Felix Willgerodt Subject: [PATCH] gdb/fortran: Add Fortran 'loc' intrinic Date: Thu, 26 Sep 2019 05:08:06 +0200 Message-Id: <20190926030806.14177-1-tkulasek@sii.pl> X-IsSubscribed: yes From: Abhishek Aggarwal - LOC() intrinsic can be used now during debugging the Fortran Applications using GDB Signed-off-by: Abhishek Aggarwal Signed-off-by: Felix Willgerodt --- gdb/ax-gdb.c | 35 +++++++++++++++++++++++++++++++++++ gdb/eval.c | 13 +++++++++++++ gdb/expprint.c | 1 + gdb/f-exp.y | 7 ++++++- gdb/std-operator.def | 1 + 5 files changed, 56 insertions(+), 1 deletion(-) diff --git a/gdb/ax-gdb.c b/gdb/ax-gdb.c index 9f1b7a1e88..ae0b4c325b 100644 --- a/gdb/ax-gdb.c +++ b/gdb/ax-gdb.c @@ -131,6 +131,7 @@ static void gen_logical_not (struct agent_expr *ax, struct axs_value *value, static void gen_complement (struct agent_expr *ax, struct axs_value *value); static void gen_deref (struct axs_value *); static void gen_address_of (struct axs_value *); +static void gen_loc (struct agent_expr *, struct axs_value *); static void gen_bitfield_ref (struct agent_expr *ax, struct axs_value *value, struct type *type, int start, int end); static void gen_primitive_field (struct agent_expr *ax, @@ -1248,6 +1249,34 @@ gen_address_of (struct axs_value *value) } } +/* Produce the output of LOC intrinsic. + (i.e. produce address of lvalue on the top of the stack) */ +static void +gen_loc (struct agent_expr *ax, struct axs_value *value) +{ + /* LOC is not a Standard Fortran Intrinsic. However, different vendors have + different definition for LOC. Some definitions accept function name + also as an argument of LOC (apart from a variable name). + Hence, Address of Function is taken care of separately like this. */ + if (TYPE_CODE (value->type) == TYPE_CODE_FUNC) + /* The value's already an rvalue on the stack, so just change the type.*/ + value->type = lookup_pointer_type (value->type); + else + switch (value->kind) + { + case axs_rvalue: + error (_("Operand of `loc' is an rvalue, which has no address.")); + + case axs_lvalue_register: + error (_("Operand of `loc' is in a register, and has no address.")); + + case axs_lvalue_memory: + value->kind = axs_rvalue; + value->type = lookup_pointer_type (value->type); + break; + } +} + /* Generate code to push the value of a bitfield of a structure whose address is on the top of the stack. START and END give the starting and one-past-ending *bit* numbers of the field within the @@ -2192,6 +2221,12 @@ gen_expr (struct expression *exp, union exp_element **pc, gen_address_of (value); break; + case UNOP_LOC: + (*pc)++; + gen_expr (exp, pc, ax, value); + gen_loc (ax, value); + break; + case UNOP_SIZEOF: (*pc)++; /* Notice that gen_sizeof handles its own operand, unlike most diff --git a/gdb/eval.c b/gdb/eval.c index aed89e5f85..d5a306d078 100644 --- a/gdb/eval.c +++ b/gdb/eval.c @@ -2730,6 +2730,19 @@ evaluate_subexp_standard (struct type *expect_type, return value_from_longest (size_type, align); } + case UNOP_LOC: + if (noside == EVAL_SKIP) + { + evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); + return eval_skip_value (exp); + } + else + { + struct value *retvalp = evaluate_subexp_for_address (exp, pos, + noside); + return retvalp; + } + case UNOP_CAST: (*pos) += 2; type = exp->elts[pc + 1].type; diff --git a/gdb/expprint.c b/gdb/expprint.c index d7ad1a7187..82d6587e0d 100644 --- a/gdb/expprint.c +++ b/gdb/expprint.c @@ -858,6 +858,7 @@ dump_subexp_body_standard (struct expression *exp, case UNOP_POSTDECREMENT: case UNOP_SIZEOF: case UNOP_ALIGNOF: + case UNOP_LOC: case UNOP_PLUS: case UNOP_CAP: case UNOP_CHR: diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 9784ad57d8..eb93da5f82 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -159,7 +159,7 @@ static int parse_number (struct parser_state *, const char *, int, %token NAME_OR_INT -%token SIZEOF KIND +%token SIZEOF KIND LOC %token ERROR /* Special type cases, put in to allow the parser to distinguish different @@ -239,6 +239,10 @@ exp : SIZEOF exp %prec UNARY { write_exp_elt_opcode (pstate, UNOP_SIZEOF); } ; +exp : LOC exp %prec UNARY + { write_exp_elt_opcode (pstate, UNOP_LOC); } + ; + exp : KIND '(' exp ')' %prec UNARY { write_exp_elt_opcode (pstate, UNOP_FORTRAN_KIND); } ; @@ -969,6 +973,7 @@ static const struct token f77_keywords[] = { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false }, { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false }, { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false }, + { "loc", LOC, BINOP_END, false }, }; /* Implementation of a dynamically expandable buffer for processing input diff --git a/gdb/std-operator.def b/gdb/std-operator.def index a5247ab940..847ab56d94 100644 --- a/gdb/std-operator.def +++ b/gdb/std-operator.def @@ -235,6 +235,7 @@ OP (UNOP_PREDECREMENT) /* -- before an expression */ OP (UNOP_POSTDECREMENT) /* -- after an expression */ OP (UNOP_SIZEOF) /* Unary sizeof (followed by expression) */ OP (UNOP_ALIGNOF) /* Unary alignof (followed by expression) */ +OP (UNOP_LOC) /* Unary loc (followed by expression) */ OP (UNOP_PLUS) /* Unary plus */