From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 7/9] Write docstrings into RTL ELF images Date: Tue, 4 Jun 2013 16:44:08 +0200 Message-ID: <1370357050-26337-8-git-send-email-wingo@pobox.com> References: <1370357050-26337-1-git-send-email-wingo@pobox.com> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1370357124 3955 80.91.229.3 (4 Jun 2013 14:45:24 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 4 Jun 2013 14:45:24 +0000 (UTC) Cc: Andy Wingo To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Jun 04 16:45:25 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UjsUG-00017I-Ff for guile-devel@m.gmane.org; Tue, 04 Jun 2013 16:45:24 +0200 Original-Received: from localhost ([::1]:52458 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UjsUF-0007DG-IB for guile-devel@m.gmane.org; Tue, 04 Jun 2013 10:45:23 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55263) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UjsTs-0006le-5g for guile-devel@gnu.org; Tue, 04 Jun 2013 10:45:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UjsTn-0001z4-OB for guile-devel@gnu.org; Tue, 04 Jun 2013 10:45:00 -0400 Original-Received: from a-pb-sasl-quonix.pobox.com ([208.72.237.25]:58874 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UjsTn-0001yz-K6 for guile-devel@gnu.org; Tue, 04 Jun 2013 10:44:55 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 575CDC823; Tue, 4 Jun 2013 10:44:55 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:date:message-id:in-reply-to:references; s=sasl; bh=FxfV +5zQDnY4DLe5NhJSDmltfsg=; b=LVn99QUNhoJ/vnnXIllJ83m5lIfYA9dQKCnS eRBCnEv95DG0l04etLHOV8NguhpD7ry2AObslXWtaqQb+L7lujVDAgiwdQEU0s97 rrBg6DIqxUop3QUrCpKJc8G4RsousL08cZ0WJNHSniiRJK+kIzCdomHaC/FNOxs0 KLPionk= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:date:message-id:in-reply-to:references; q=dns; s=sasl; b= nA7Ig39C1XO+Ew5uY4kchdrBzrLVcHLpOx/grjQNkjOrwONwo8/yZgwiaJdiowfB FcEYmsnH+V9o6eMRzMiR+orMqgQXmofMsiaGjr2cb4ikA2vIN9/g16Mh5jNofmvf xTdokb0szeBnDgB9UjVtHXN0NMTIWur69bExxsm0pfE= Original-Received: from a-pb-sasl-quonix.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 4E388C822; Tue, 4 Jun 2013 10:44:55 -0400 (EDT) Original-Received: from localhost.localdomain (unknown [88.5.174.195]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTPSA id 4515AC821; Tue, 4 Jun 2013 10:44:53 -0400 (EDT) X-Mailer: git-send-email 1.7.10.4 In-Reply-To: <1370357050-26337-1-git-send-email-wingo@pobox.com> X-Pobox-Relay-ID: 51E4912A-CD25-11E2-A30A-9F710E5B5709-02397024!a-pb-sasl-quonix.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 X-Received-From: 208.72.237.25 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16463 Archived-At: * module/system/vm/assembler.scm (link-docstrs): Write docstrings. (link-objects): Link docstrings into the ELF. --- module/system/vm/assembler.scm | 58 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 57 insertions(+), 1 deletion(-) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 7718574..3fe4692 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1167,6 +1167,61 @@ (linker-object-section strtab))) strtab))))) +;;; +;;; The .guile.docstrs section is a packed, sorted array of (pc, str) +;;; values. Pc and str are both 32 bits wide. (Either could change to +;;; 64 bits if appropriate in the future.) Pc is the address of the +;;; entry to a program, relative to the start of the text section, and +;;; str is an index into the associated .guile.docstrs.strtab string +;;; table section. +;;; + +;; The size of a docstrs entry, in bytes. +(define docstr-size 8) + +(define (link-docstrs asm) + (define (find-docstrings) + (filter-map (lambda (meta) + (define (is-documentation? pair) + (eq? (car pair) 'documentation)) + (let* ((props (meta-properties meta)) + (tail (find-tail is-documentation? props))) + (and tail + (not (find-tail is-documentation? (cdr tail))) + (string? (cdar tail)) + (cons (meta-low-pc meta) (cdar tail))))) + (reverse (asm-meta asm)))) + (let* ((endianness (asm-endianness asm)) + (docstrings (find-docstrings)) + (strtab (make-string-table)) + (bv (make-bytevector (* (length docstrings) docstr-size) 0))) + (define (intern-string! name) + (call-with-values + (lambda () (string-table-intern strtab name)) + (lambda (table idx) + (set! strtab table) + idx))) + (fold (lambda (pair pos) + (match pair + ((pc . string) + (bytevector-u32-set! bv pos pc endianness) + (bytevector-u32-set! bv (+ pos 4) (intern-string! string) + endianness) + (+ pos docstr-size)))) + 0 + docstrings) + (let ((strtab (make-object asm '.guile.docstrs.strtab + (link-string-table strtab) + '() '() + #:type SHT_STRTAB #:flags 0))) + (values (make-object asm '.guile.docstrs + bv + '() '() + #:type SHT_PROGBITS #:flags 0 + #:link (elf-section-index + (linker-object-section strtab))) + strtab)))) + (define (link-objects asm) (let*-values (((ro rw rw-init) (link-constants asm)) ;; Link text object after constants, so that the @@ -1175,12 +1230,13 @@ ((dt) (link-dynamic-section asm text ro rw rw-init)) ((symtab strtab) (link-symtab (linker-object-section text) asm)) ((arities arities-strtab) (link-arities asm)) + ((docstrs docstrs-strtab) (link-docstrs asm)) ;; This needs to be linked last, because linking other ;; sections adds entries to the string table. ((shstrtab) (link-shstrtab asm))) (filter identity (list text ro rw dt symtab strtab arities arities-strtab - shstrtab)))) + docstrs docstrs-strtab shstrtab)))) (define (link-assembly asm) (link-elf (link-objects asm))) -- 1.7.10.4