From patchwork Mon Jul 21 13:23:29 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Doug Evans X-Patchwork-Id: 2124 Received: (qmail 30092 invoked by alias); 21 Jul 2014 13:23:37 -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 29970 invoked by uid 89); 21 Jul 2014 13:23:36 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD, SPF_PASS, URIBL_BLACK autolearn=no version=3.3.2 X-HELO: mail-ie0-f201.google.com Received: from mail-ie0-f201.google.com (HELO mail-ie0-f201.google.com) (209.85.223.201) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Mon, 21 Jul 2014 13:23:33 +0000 Received: by mail-ie0-f201.google.com with SMTP id tr6so2270242ieb.2 for ; Mon, 21 Jul 2014 06:23:31 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:subject:date:message-id:mime-version :content-type:content-transfer-encoding; bh=bhK5GdSFCcv2qNX/1zJpJOnFAzbTjUydJXF21vq9n8g=; b=G9w+evE5pq4WABGJ++DAO+rwr4wc9JK2RyQuVu5qweVm7nTWkFX4FVjVkv0mdNNYxT B9Fi/g04Br+5bW6weylsutc+mRMJTriUkovwu0BVU9f2/cb71vNJwPrfw02LcEeEMcyr On1iuf78JmUlQvf24YUWtRLOl75cb5Ugen16GdrVzGfyerlbVnWiof/+CWiY1uc8XId1 fecMBoTOoTbL02pVuP5uMElL6FhgI4lwggHOifoLG6TvKCxsB8jTPVKtUIq5hddkFXFZ Sc4kTsZZ73+SZiGk4ct15mck9Dz7DBq/02Z2UGSMm9Xy79QebOZtdOqmYNIEiBv6e1U/ 9o1A== X-Gm-Message-State: ALoCoQn2+H93kMNybG33/k2aNVRuhUt5OcVBNdyFP5vGXizfWWH+D9awLa4hVXAb/HT5ouTQDvzt X-Received: by 10.182.112.202 with SMTP id is10mr12765817obb.47.1405949010304; Mon, 21 Jul 2014 06:23:30 -0700 (PDT) Received: from corp2gmr1-2.hot.corp.google.com (corp2gmr1-2.hot.corp.google.com [172.24.189.93]) by gmr-mx.google.com with ESMTPS id v44si1010978yhv.0.2014.07.21.06.23.30 for (version=TLSv1.1 cipher=ECDHE-RSA-AES128-SHA bits=128/128); Mon, 21 Jul 2014 06:23:30 -0700 (PDT) Received: from ruffy.mtv.corp.google.com (ruffy.mtv.corp.google.com [172.17.128.44]) by corp2gmr1-2.hot.corp.google.com (Postfix) with ESMTP id C055A5A4319; Mon, 21 Jul 2014 06:23:29 -0700 (PDT) From: Doug Evans To: gdb-patches@sourceware.org, ludo@gnu.org Subject: [PATCH v2 1/2] guile: Compile and install Scheme files Date: Mon, 21 Jul 2014 06:23:29 -0700 Message-ID: MIME-Version: 1.0 X-IsSubscribed: yes Hi. This is v2 of a patch set to compile the Scheme files when gdb is built. Guile will auto-compile them as needed when they are loaded, just like Python, but Guile is a bit too verbose about it. In order to silence Guile, this patch pre-compiles them. Fortunately, guild (wrapper around the guile compiler) can cross-compile. Therefore this works even if cross-compiling gdb. To be conservative, configure.ac does a test compile, and if that fails then guile support is disabled. I have tested cross-compiling to i686-linux from amd64-linux, and tested the resulting gdb. I have also done a hand cross-compile from amd64-linux to i686-pc-mingw (I didn't test that gdb+guile works in this case, just that the cross-compile succeeded). This first patch does some preparatory work for the real patch in 2/2. This is PR guile/17146. 2014-07-21 Ludovic Courtès Doug Evans * data-directory/Makefile.in (GUILE_FILES): Add support.scm. * guile/lib/gdb/support.scm: New file. * guile/guile.c (gdbscm_init_module_name): Change to "gdb". * guile/lib/gdb.scm: Load gdb/init.scm as an include file. All uses updated. * guile/lib/gdb/init.scm (SCM_ARG1, SCM_ARG2): Moved to support.scm. All uses updated. (%assert-type): Ditto, and renamed to assert-type. (%exception-print-style): Delete. testsuite/ * gdb.guile/types-module.exp: Add tests for wrong type arguments. diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in index b9fcc03..26a507f 100644 --- a/gdb/data-directory/Makefile.in +++ b/gdb/data-directory/Makefile.in @@ -84,6 +84,7 @@ GUILE_FILES = \ gdb/init.scm \ gdb/iterator.scm \ gdb/printing.scm \ + gdb/support.scm \ gdb/types.scm SYSTEM_GDBINIT_DIR = system-gdbinit diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index 05dba69..103c599 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -117,7 +117,7 @@ static SCM to_string_keyword; /* The name of the various modules (without the surrounding parens). */ const char gdbscm_module_name[] = "gdb"; -const char gdbscm_init_module_name[] = "gdb init"; +const char gdbscm_init_module_name[] = "gdb"; /* The name of the bootstrap file. */ static const char boot_scm_filename[] = "boot.scm"; diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm index 120fcc6..048baf9 100644 --- a/gdb/guile/lib/gdb.scm +++ b/gdb/guile/lib/gdb.scm @@ -492,11 +492,11 @@ ;; Load the rest of the Scheme side. -(use-modules ((gdb init))) +(include "gdb/init.scm") ;; These come from other files, but they're really part of this module. -(re-export +(export ;; init.scm orig-input-port diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm index 8c0bb35..6159354 100644 --- a/gdb/guile/lib/gdb/boot.scm +++ b/gdb/guile/lib/gdb/boot.scm @@ -26,5 +26,5 @@ (load-from-path "gdb.scm") ;; Now that the Scheme side support is loaded, initialize it. -(let ((init-proc (@@ (gdb init) %initialize!))) +(let ((init-proc (@@ (gdb) %initialize!))) (init-proc)) diff --git a/gdb/guile/lib/gdb/experimental.scm b/gdb/guile/lib/gdb/experimental.scm index ffded84..9e5a53e 100644 --- a/gdb/guile/lib/gdb/experimental.scm +++ b/gdb/guile/lib/gdb/experimental.scm @@ -22,8 +22,7 @@ ;; E.g., (gdb experimental ports), etc. (define-module (gdb experimental) - #:use-module (gdb) - #:use-module (gdb init)) + #:use-module (gdb)) ;; These are defined in C. (define-public with-gdb-output-to-port (@@ (gdb) %with-gdb-output-to-port)) diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm index 7607d49..98888ed 100644 --- a/gdb/guile/lib/gdb/init.scm +++ b/gdb/guile/lib/gdb/init.scm @@ -17,20 +17,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . -(define-module (gdb init) - #:use-module (gdb)) - -(define-public SCM_ARG1 1) -(define-public SCM_ARG2 2) +;; This file is included by (gdb). ;; The original i/o ports. In case the user wants them back. (define %orig-input-port #f) (define %orig-output-port #f) (define %orig-error-port #f) -;; %exception-print-style is exported as "private" by gdb. -(define %exception-print-style (@@ (gdb) %exception-print-style)) - ;; Keys for GDB-generated exceptions. ;; gdb:with-stack is handled separately. @@ -142,15 +135,6 @@ (%print-exception-message port frame key args))))) -;; Internal utility to check the type of an argument, akin to SCM_ASSERT_TYPE. -;; It's public so other gdb modules can use it. - -(define-public (%assert-type test-result arg pos func-name) - (if (not test-result) - (scm-error 'wrong-type-arg func-name - "Wrong type argument in position ~a: ~s" - (list pos arg) (list arg)))) - ;; Internal utility called during startup to initialize the Scheme side of ;; GDB+Guile. diff --git a/gdb/guile/lib/gdb/iterator.scm b/gdb/guile/lib/gdb/iterator.scm index 9cfbe85..2748931 100644 --- a/gdb/guile/lib/gdb/iterator.scm +++ b/gdb/guile/lib/gdb/iterator.scm @@ -19,11 +19,12 @@ ;; along with this program. If not, see . (define-module (gdb iterator) - #:use-module (gdb)) + #:use-module (gdb) + #:use-module (gdb support)) (define-public (make-list-iterator l) "Return a object for a list." - (%assert-type (list? l) l SCM_ARG1 'make-list-iterator) + (assert-type (list? l) l SCM_ARG1 'make-list-iterator "list") (let ((next! (lambda (iter) (let ((l (iterator-progress iter))) (if (eq? l '()) diff --git a/gdb/guile/lib/gdb/printing.scm b/gdb/guile/lib/gdb/printing.scm index eac9417..53ae83d 100644 --- a/gdb/guile/lib/gdb/printing.scm +++ b/gdb/guile/lib/gdb/printing.scm @@ -22,13 +22,13 @@ (*pretty-printers* pretty-printer? objfile? progspace? objfile-pretty-printers set-objfile-pretty-printers! progspace-pretty-printers set-progspace-pretty-printers!)) - #:use-module (gdb init)) + #:use-module (gdb support)) (define-public (prepend-pretty-printer! obj matcher) "Add MATCHER to the beginning of the pretty-printer list for OBJ. If OBJ is #f, add MATCHER to the global list." - (%assert-type (pretty-printer? matcher) matcher SCM_ARG1 - 'prepend-pretty-printer!) + (assert-type (pretty-printer? matcher) matcher SCM_ARG1 + 'prepend-pretty-printer! "pretty-printer") (cond ((eq? obj #f) (set! *pretty-printers* (cons matcher *pretty-printers*))) ((objfile? obj) @@ -38,13 +38,14 @@ If OBJ is #f, add MATCHER to the global list." (set-progspace-pretty-printers! obj (cons matcher (progspace-pretty-printers obj)))) (else - (%assert-type #f obj SCM_ARG1 'prepend-pretty-printer!)))) + (assert-type #f obj SCM_ARG1 'prepend-pretty-printer! + "#f, objfile, or progspace")))) (define-public (append-pretty-printer! obj matcher) "Add MATCHER to the end of the pretty-printer list for OBJ. If OBJ is #f, add MATCHER to the global list." - (%assert-type (pretty-printer? matcher) matcher SCM_ARG1 - 'append-pretty-printer!) + (assert-type (pretty-printer? matcher) matcher SCM_ARG1 + 'append-pretty-printer! "pretty-printer") (cond ((eq? obj #f) (set! *pretty-printers* (append! *pretty-printers* (list matcher)))) ((objfile? obj) @@ -54,4 +55,5 @@ If OBJ is #f, add MATCHER to the global list." (set-progspace-pretty-printers! obj (append! (progspace-pretty-printers obj) (list matcher)))) (else - (%assert-type #f obj SCM_ARG1 'append-pretty-printer!)))) + (assert-type #f obj SCM_ARG1 'append-pretty-printer! + "#f, objfile, or progspace")))) diff --git a/gdb/guile/lib/gdb/support.scm b/gdb/guile/lib/gdb/support.scm new file mode 100644 index 0000000..dc6c20f --- /dev/null +++ b/gdb/guile/lib/gdb/support.scm @@ -0,0 +1,33 @@ +;; Internal support routines. +;; +;; Copyright (C) 2014 Free Software Foundation, Inc. +;; +;; This file is part of GDB. +;; +;; This program 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 3 of the License, or +;; (at your option) any later version. +;; +;; This program 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 this program. If not, see . + +(define-module (gdb support)) + +;; Symbolic values for the ARG parameter of assert-type. + +(define-public SCM_ARG1 1) +(define-public SCM_ARG2 2) + +;; Utility to check the type of an argument, akin to SCM_ASSERT_TYPE. + +(define-public (assert-type test-result arg pos func-name expecting) + (if (not test-result) + (scm-error 'wrong-type-arg func-name + "Wrong type argument in position ~a (expecting ~a): ~s" + (list pos expecting arg) (list arg)))) diff --git a/gdb/guile/lib/gdb/types.scm b/gdb/guile/lib/gdb/types.scm index 31ea192..296d170 100644 --- a/gdb/guile/lib/gdb/types.scm +++ b/gdb/guile/lib/gdb/types.scm @@ -16,8 +16,8 @@ (define-module (gdb types) #:use-module (gdb) - #:use-module (gdb init) - #:use-module (gdb iterator)) + #:use-module (gdb iterator) + #:use-module (gdb support)) (define-public (type-has-field-deep? type field-name) "Return #t if the type, including baseclasses, has the specified field. @@ -50,8 +50,8 @@ (set! type (type-target type))) (set! type (type-strip-typedefs type)) - (%assert-type (memq (type-code type) (list TYPE_CODE_STRUCT TYPE_CODE_UNION)) - type SCM_ARG1 'type-has-field-deep?) + (assert-type (memq (type-code type) (list TYPE_CODE_STRUCT TYPE_CODE_UNION)) + type SCM_ARG1 'type-has-field-deep? "struct or union") (search-class type)) @@ -69,8 +69,8 @@ Raises: wrong-type-arg: The type is not an enum." - (%assert-type (= (type-code enum-type) TYPE_CODE_ENUM) - enum-type SCM_ARG1 'make-enum-hashtable) + (assert-type (= (type-code enum-type) TYPE_CODE_ENUM) + enum-type SCM_ARG1 'make-enum-hashtable "enum") (let ((htab (make-hash-table))) (for-each (lambda (enum) (hash-set! htab (field-name enum) (field-enumval enum))) diff --git a/gdb/testsuite/gdb.guile/types-module.exp b/gdb/testsuite/gdb.guile/types-module.exp index 8562f3c..4dd5ee4 100644 --- a/gdb/testsuite/gdb.guile/types-module.exp +++ b/gdb/testsuite/gdb.guile/types-module.exp @@ -43,8 +43,20 @@ gdb_test "guile (print (type-has-field? d \"base_member\"))" \ gdb_test "guile (print (type-has-field-deep? d \"base_member\"))" \ "= #t" "type-has-field-deep? member in baseclass" +gdb_test "guile (print (type-has-field-deep? (lookup-type \"int\") \"base_member\"))" \ + "ERROR: .*Wrong type argument in position 1 \\(expecting struct or union\\): #.*" \ + "type-has-field-deep? from int" + gdb_scm_test_silent_cmd "guile (define enum-htab (make-enum-hashtable (lookup-type \"enum_type\")))" \ "create enum hash table" gdb_test "guile (print (hash-ref enum-htab \"B\"))" \ "= 1" "verify make-enum-hashtable" + +gdb_test "guile (define bad-enum-htab (make-enum-hashtable #f))" \ + "ERROR: .*Wrong type argument in position 1 \\(expecting gdb:type\\): #f.*" \ + "make-enum-hashtable from #f" + +gdb_test "guile (define bad-enum-htab (make-enum-hashtable (lookup-type \"int\")))" \ + "ERROR: .*Wrong type argument in position 1 \\(expecting enum\\): #.*" \ + "make-enum-hashtable from int"