From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 15799 invoked by alias); 11 Nov 2013 06:28:59 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Received: (qmail 15783 invoked by uid 89); 11 Nov 2013 06:28:58 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.8 required=5.0 tests=AWL,BAYES_20,FREEMAIL_ENVFROM_END_DIGIT,FREEMAIL_FROM,KAM_STOCKGEN,RDNS_NONE,SPF_PASS,URIBL_BLOCKED autolearn=no version=3.3.2 X-HELO: mail-pb0-f44.google.com Received: from Unknown (HELO mail-pb0-f44.google.com) (209.85.160.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Mon, 11 Nov 2013 06:28:57 +0000 Received: by mail-pb0-f44.google.com with SMTP id rp16so4756452pbb.17 for ; Sun, 10 Nov 2013 22:28:49 -0800 (PST) X-Received: by 10.66.154.197 with SMTP id vq5mr1160842pab.155.1384151329140; Sun, 10 Nov 2013 22:28:49 -0800 (PST) Received: from seba.sebabeach.org.gmail.com (173-13-178-50-sfba.hfc.comcastbusiness.net. [173.13.178.50]) by mx.google.com with ESMTPSA id hz10sm28469786pbc.36.2013.11.10.22.28.47 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sun, 10 Nov 2013 22:28:48 -0800 (PST) From: Doug Evans To: Ludovic =?utf-8?Q?Court=C3=A8s?= , guile-user@gnu.org, gdb-patches@sourceware.org Subject: Re: guile scripting for gdb References: <87ob5vlr2s.fsf@gnu.org> <87k3gfpz7k.fsf@gnu.org> Date: Mon, 11 Nov 2013 06:37:00 -0000 In-Reply-To: (Doug Evans's message of "Sun, 10 Nov 2013 17:50:00 -0800") Message-ID: User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-IsSubscribed: yes X-SW-Source: 2013-11/txt/msg00270.txt.bz2 Doug Evans writes: > On Sun, Nov 10, 2013 at 4:19 PM, Ludovic Court=C3=A8s wrot= e: >> Doug Evans skribis: >>> On Thu, Nov 7, 2013 at 3:39 PM, Ludovic Court=C3=A8s wro= te: >>>> As discussed on IRC, one possible issue is eq?-ness of SMOBs: one would >>>> usually expects pointer equality to be preserved at the Scheme level. I uploaded to my github repo a branch with a prototype of implementing this for gdb symbols. https://github.com/dje42/gdb.git branch: eq-smobs diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h index 30abd97..c5bc939 100644 --- a/gdb/guile/guile-internal.h +++ b/gdb/guile/guile-internal.h @@ -23,6 +23,7 @@ #ifndef GDB_GUILE_INTERNAL_H #define GDB_GUILE_INTERNAL_H =20 +#include "hashtab.h" #include "scripting.h" #include "symtab.h" #include "libguile.h" @@ -213,6 +214,12 @@ extern void gdbscm_add_objfile_ref (struct objfile *ob= jfile, extern void gdbscm_remove_objfile_ref (struct objfile *objfile, const struct objfile_data *data_key, chained_gdb_smob *g_smob); + +extern htab_t gdbscm_create_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_f= n); + +extern void **gdbscm_find_gsmob_ptr_slot (htab_t htab, void *ptr, int inse= rt); + +extern void gdbscm_clear_gsmob_ptr_slot (htab_t htab, void *ptr); =0C /* Exceptions and calling out to Guile. */ =20 diff --git a/gdb/guile/scm-smob.c b/gdb/guile/scm-smob.c index b342e87..40d8a4c 100644 --- a/gdb/guile/scm-smob.c +++ b/gdb/guile/scm-smob.c @@ -395,6 +395,46 @@ gdbscm_remove_objfile_ref (struct objfile *objfile, if (g_smob->next) g_smob->next->prev =3D g_smob->prev; } + +/* Create a hash table for mapping a pointer to a gdb data structure to the + gsmob that wraps it. */ + +htab_t +gdbscm_create_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_fn) +{ + htab_t htab =3D htab_create_alloc (7, hash_fn, eq_fn, + NULL, xcalloc, xfree); + + return htab; +} + +/* Return a pointer to the htab entry for the gsmob wrapping PTR. + If INSERT is non-zero, create an entry if one doesn't exist. + Otherwise NULL is returned if the entry is not found. */ + +void ** +gdbscm_find_gsmob_ptr_slot (htab_t htab, void *ptr, int insert) +{ + void **slot =3D htab_find_slot (htab, ptr, insert ? INSERT : NO_INSERT); + + return slot; +} + +/* Remove PTR from HTAB. + PTR is a pointer to a gsmob that wraps a pointer to a GDB datum. + This is used, for example, when an object is freed. + + It is an error to call this if PTR is not in HTAB (only because it allo= ws + for some consistency checking). */ + +void +gdbscm_clear_gsmob_ptr_slot (htab_t htab, void *ptr) +{ + void **slot =3D htab_find_slot (htab, ptr, NO_INSERT); + + gdb_assert (slot !=3D NULL); + htab_clear_slot (htab, slot); +} =0C /* Initialize the Scheme gsmobs code. */ =20 diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c index 0c9f531..e3122c6 100644 --- a/gdb/guile/scm-symbol.c +++ b/gdb/guile/scm-symbol.c @@ -32,14 +32,16 @@ /* The smob. */ =20 typedef struct { - /* This always appears first. - A symbol object is associated with an objfile, so use a chained_gdb_s= mob - to keep track of all symbols associated with the objfile. This lets = us - invalidate the underlying struct symbol when the objfile is deleted. = */ - chained_gdb_smob base; + /* This always appears first. */ + gdb_smob base; =20 /* The GDB symbol structure this smob is wrapping. */ struct symbol *symbol; + + /* Backlink to our containing SCM. + This is used by the eq? machinery: We need to be able to see if we ha= ve + already created a gsmob for a symbol, and if so use that SCM. */ + SCM containing_scm; } symbol_smob; =20 static const char symbol_smob_name[] =3D "gdb:symbol"; @@ -56,6 +58,46 @@ static const struct objfile_data *syscm_objfile_data_key; =0C /* Administrivia for symbol smobs. */ =20 +/* Helper function to hash a symbol_smob. */ + +static hashval_t +syscm_hash_symbol_smob (const void *p) +{ + const symbol_smob *s_smob =3D p; + + return htab_hash_pointer (s_smob->symbol); +} + +/* Helper function to compute equality of symbol_smobs. */ + +static int +syscm_eq_symbol_smob (const void *ap, const void *bp) +{ + const symbol_smob *a =3D ap; + const symbol_smob *b =3D bp; + + return a->symbol =3D=3D b->symbol; +} + +/* Return the struct symbol pointer -> SCM mapping table. + It is created if necessary. */ + +static htab_t +syscm_objfile_symbol_map (struct symbol *symbol) +{ + struct objfile *objfile =3D SYMBOL_SYMTAB (symbol)->objfile; + htab_t htab =3D objfile_data (objfile, syscm_objfile_data_key); + + if (htab =3D=3D NULL) + { + htab =3D gdbscm_create_gsmob_ptr_map (syscm_hash_symbol_smob, + syscm_eq_symbol_smob); + set_objfile_data (objfile, syscm_objfile_data_key, htab); + } + + return htab; +} + /* The smob "mark" function for . */ =20 static SCM @@ -63,8 +105,10 @@ syscm_mark_symbol_smob (SCM self) { symbol_smob *s_smob =3D (symbol_smob *) SCM_SMOB_DATA (self); =20 + /* There's no need to mark containing_scm. */ + /* Do this last. */ - return gdbscm_mark_chained_gsmob (&s_smob->base); + return gdbscm_mark_gsmob (&s_smob->base); } =20 /* The smob "free" function for . */ @@ -74,11 +118,13 @@ syscm_free_symbol_smob (SCM self) { symbol_smob *s_smob =3D (symbol_smob *) SCM_SMOB_DATA (self); =20 - gdbscm_remove_objfile_ref ((s_smob->symbol !=3D NULL - && SYMBOL_SYMTAB (s_smob->symbol) !=3D NULL) - ? SYMBOL_SYMTAB (s_smob->symbol)->objfile - : NULL, - syscm_objfile_data_key, &s_smob->base); + if (s_smob->symbol !=3D NULL) + { + htab_t htab =3D syscm_objfile_symbol_map (s_smob->symbol); + + gdbscm_clear_gsmob_ptr_slot (htab, s_smob); + } + /* Not necessary, done to catch bugs. */ s_smob->symbol =3D NULL; =20 @@ -133,7 +179,7 @@ syscm_make_symbol_smob (void) =20 s_smob->symbol =3D NULL; s_scm =3D scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob); - gdbscm_init_chained_gsmob (&s_smob->base); + gdbscm_init_gsmob (&s_smob->base); =20 return s_scm; } @@ -155,47 +201,44 @@ gdbscm_symbol_p (SCM scm) } =20 /* Create a new object that encapsulates SYMBOL. - The new symbol is registered with the life-cycle chain of the - associated objfile (if any). */ - -SCM -syscm_gsmob_from_symbol (struct symbol *symbol) -{ - SCM s_scm =3D syscm_make_symbol_smob (); - symbol_smob *s_smob =3D (symbol_smob *) SCM_SMOB_DATA (s_scm); - - gdbscm_add_objfile_ref (SYMBOL_SYMTAB (symbol) - ? SYMBOL_SYMTAB (symbol)->objfile - : NULL, - syscm_objfile_data_key, &s_smob->base); - s_smob->symbol =3D symbol; - - return s_scm; -} - -/* Create a new object that encapsulates SYMBOL. The object is passed through *smob->scm*. A Scheme exception is thrown if there is an error. */ =20 SCM syscm_scm_from_symbol_unsafe (struct symbol *symbol) { - /* This doesn't use syscm_gsmob_from_symbol because we don't want to - cause any side-effects until we know the conversion worked. */ - SCM s_scm =3D syscm_make_symbol_smob (); - symbol_smob *s_smob =3D (symbol_smob *) SCM_SMOB_DATA (s_scm); + htab_t htab; + void **slot; + SCM s_scm; + symbol_smob *s_smob, s_smob_for_lookup; SCM result; =20 + /* If we've already created a gsmob for this symbol, return it. + This makes symbols eq?-able. + We call gdbscm_find_gsmob_ptr_slot twice because we don't want to lea= ve + the side-effect of the INSERT behind if we later throw an exception. = */ + htab =3D syscm_objfile_symbol_map (symbol); + s_smob_for_lookup.symbol =3D symbol; + slot =3D gdbscm_find_gsmob_ptr_slot (htab, &s_smob_for_lookup, 0); + if (slot !=3D NULL) + { + s_smob =3D *slot; + return s_smob->containing_scm; + } + + s_scm =3D syscm_make_symbol_smob (); + s_smob =3D (symbol_smob *) SCM_SMOB_DATA (s_scm); + result =3D gdbscm_scm_from_gsmob_unsafe (s_scm); =20 if (gdbscm_is_exception (result)) gdbscm_throw (result); =20 - gdbscm_add_objfile_ref (SYMBOL_SYMTAB (symbol) - ? SYMBOL_SYMTAB (symbol)->objfile - : NULL, - syscm_objfile_data_key, &s_smob->base); s_smob->symbol =3D symbol; + s_smob->containing_scm =3D result; + + slot =3D gdbscm_find_gsmob_ptr_slot (htab, s_smob, 1); + *slot =3D s_smob; =20 return result; } @@ -282,26 +325,33 @@ syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_= pos, return s_smob->symbol; } =20 +/* Helper function for syscm_del_objfile_symbols to mark the symbol + as invalid. */ + +static int +syscm_mark_symbol_invalid (void **slot, void *info) +{ + symbol_smob *s_smob =3D (symbol_smob *) *slot; + + s_smob->symbol =3D NULL; + return 1; +} + /* This function is called when an objfile is about to be freed. Invalidate the symbol as further actions on the symbol would result in bad data. All access to s_smob->symbol should be gated by - syscm_get_valid_symbol_smob_arg which will raise an exception on invalid - symbols. */ + syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on + invalid symbols. */ =20 static void syscm_del_objfile_symbols (struct objfile *objfile, void *datum) { - symbol_smob *s_smob =3D datum; + htab_t htab =3D datum; =20 - while (s_smob !=3D NULL) + if (htab !=3D NULL) { - symbol_smob *next =3D (symbol_smob *) s_smob->base.next; - - s_smob->symbol =3D NULL; - s_smob->base.next =3D NULL; - s_smob->base.prev =3D NULL; - - s_smob =3D next; + htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL); + htab_delete (htab); } } =0C diff --git a/gdb/testsuite/gdb.guile/scm-symbol.exp b/gdb/testsuite/gdb.gui= le/scm-symbol.exp index 44e22f1..50f0181 100644 --- a/gdb/testsuite/gdb.guile/scm-symbol.exp +++ b/gdb/testsuite/gdb.guile/scm-symbol.exp @@ -59,6 +59,12 @@ if ![gdb_guile_runto_main] { return } =20 +# Test symbol eq? and equal?. +gdb_test "guile (print (eq? (lookup-global-symbol \"main\") (lookup-global= -symbol \"main\")))" \ + "=3D #t" +gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-glo= bal-symbol \"main\")))" \ + "=3D #t" + gdb_breakpoint [gdb_get_line_number "Block break here."] gdb_continue_to_breakpoint "Block break here." gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \