summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-06-22 13:35:55 +0200
committerAndy Wingo <wingo@pobox.com>2012-06-22 13:40:50 +0200
commitb8bc86bce147cf280ca2a60d36c8b6493cbf11e8 (patch)
tree510c9f80953d586f40af3b5ad0ffa5fc7c0b2ec9 /module
parentafc74c2920d2f8f8424db9d6f554a91866cbac01 (diff)
downloadguile-b8bc86bce147cf280ca2a60d36c8b6493cbf11e8.tar.gz
instead of our custom .go format, use elf
* libguile/objcodes.c: Change to expect objcode on disk to be embedded in ELF instead of having the funky cookie. (to_native_order): Use already existing SCM_BYTE_ORDER style byte order instead of chars. (bytecode_to_objcode): No need for word_size arg. (scm_bytecode_to_objcode, scm_objcode_to_bytecode): Take optional endianness arg instead of sometimes using target-endianness. (scm_load_objcode, scm_write_objcode, scm_bytecode_to_native_objcode): Remove. * libguile/objcodes.h: Adapt. * libguile/vm.c (scm_load_compiled_with_vm): Use scm_load_thunk_from_file. (make_boot_program): Adapt to use scm_bytecode_to_objcode with endianness arg. * module/Makefile.am (OBJCODE_LANG_SOURCES): Add (language objcode elf). * module/language/objcode/elf.scm: New module, embeds objcode in ELF. * module/language/bytecode/spec.scm (compile-objcode): (decompile-objcode): Use (target-endianness). * module/language/objcode/spec.scm: use (language objcode elf) for write-objcode. * module/scripts/disassemble.scm (disassemble): * module/system/repl/command.scm (disassemble-file): Use load-thunk-from-file. * module/system/vm/objcode.scm: Remove load-objcode and write-objcode. * test-suite/tests/asm-to-bytecode.test (test-target): Adapt to the new ELF world.
Diffstat (limited to 'module')
-rw-r--r--module/Makefile.am3
-rw-r--r--module/language/bytecode/spec.scm7
-rw-r--r--module/language/objcode/elf.scm94
-rw-r--r--module/language/objcode/spec.scm1
-rw-r--r--module/scripts/disassemble.scm4
-rw-r--r--module/system/repl/command.scm4
-rw-r--r--module/system/vm/objcode.scm1
7 files changed, 105 insertions, 9 deletions
diff --git a/module/Makefile.am b/module/Makefile.am
index f49ab84cc..e300ee22b 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -123,7 +123,8 @@ BYTECODE_LANG_SOURCES = \
language/bytecode/spec.scm
OBJCODE_LANG_SOURCES = \
- language/objcode/spec.scm
+ language/objcode/spec.scm \
+ language/objcode/elf.scm
VALUE_LANG_SOURCES = \
language/value/spec.scm
diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm
index 57ccd7185..c2a6d46ab 100644
--- a/module/language/bytecode/spec.scm
+++ b/module/language/bytecode/spec.scm
@@ -1,6 +1,6 @@
;;; Guile Lowlevel Intermediate Language
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2012 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -20,14 +20,15 @@
(define-module (language bytecode spec)
#:use-module (system base language)
+ #:use-module (system base target)
#:use-module (system vm objcode)
#:export (bytecode))
(define (compile-objcode x e opts)
- (values (bytecode->objcode x) e e))
+ (values (bytecode->objcode x (target-endianness)) e e))
(define (decompile-objcode x e opts)
- (values (objcode->bytecode x) e))
+ (values (objcode->bytecode x (target-endianness)) e))
(define-language bytecode
#:title "Guile Bytecode Vectors"
diff --git a/module/language/objcode/elf.scm b/module/language/objcode/elf.scm
new file mode 100644
index 000000000..9654c0861
--- /dev/null
+++ b/module/language/objcode/elf.scm
@@ -0,0 +1,94 @@
+;;; Embedding bytecode in ELF
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+;; The eval-when is because (language objcode elf) will not be loaded
+;; yet when we go to compile it, but later passes of the
+;; compiler need it. So we have to be sure that the module is present
+;; at compile time, with all of its definitions. The easiest way to do
+;; that is just to go ahead and resolve it now.
+;;
+(define-module (language objcode elf)
+ #:use-module (system vm objcode)
+ #:use-module (system base target)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (system vm elf)
+ #:export (write-objcode))
+
+(define (bytecode->elf bv)
+ (let ((string-table (make-elf-string-table)))
+ (define (intern-string! string)
+ (call-with-values
+ (lambda () (elf-string-table-intern string-table string))
+ (lambda (table idx)
+ (set! string-table table)
+ idx)))
+ (define (make-object name bv relocs . kwargs)
+ (let ((name-idx (intern-string! (symbol->string name))))
+ (make-elf-object (apply make-elf-section
+ #:name name-idx
+ #:size (bytevector-length bv)
+ kwargs)
+ bv relocs
+ (list (make-elf-symbol name 0)))))
+ (define (make-dynamic-section word-size endianness)
+ (define (make-dynamic-section/32)
+ (let ((bv (make-bytevector 24 0)))
+ (bytevector-u32-set! bv 0 DT_GUILE_RTL_VERSION endianness)
+ (bytevector-u32-set! bv 4 #x02000000 endianness)
+ (bytevector-u32-set! bv 8 DT_GUILE_ENTRY endianness)
+ (bytevector-u32-set! bv 12 0 endianness)
+ (bytevector-u32-set! bv 16 DT_NULL endianness)
+ (bytevector-u32-set! bv 20 0 endianness)
+ (values bv (make-elf-reloc 'abs32/1 12 0 '.rtl-text))))
+ (define (make-dynamic-section/64)
+ (let ((bv (make-bytevector 48 0)))
+ (bytevector-u64-set! bv 0 DT_GUILE_RTL_VERSION endianness)
+ (bytevector-u64-set! bv 8 #x02000000 endianness)
+ (bytevector-u64-set! bv 16 DT_GUILE_ENTRY endianness)
+ (bytevector-u64-set! bv 24 0 endianness)
+ (bytevector-u64-set! bv 32 DT_NULL endianness)
+ (bytevector-u64-set! bv 40 0 endianness)
+ (values bv (make-elf-reloc 'abs64/1 24 0 '.rtl-text))))
+ (call-with-values (lambda ()
+ (case word-size
+ ((4) (make-dynamic-section/32))
+ ((8) (make-dynamic-section/64))
+ (else (error "unexpected word size" word-size))))
+ (lambda (bv reloc)
+ (make-object '.dynamic bv (list reloc)
+ #:type SHT_DYNAMIC #:flags SHF_ALLOC))))
+ (define (link-string-table)
+ (intern-string! ".shstrtab")
+ (make-object '.shstrtab (link-elf-string-table string-table) '()
+ #:type SHT_STRTAB #:flags 0))
+ (let* ((word-size (target-word-size))
+ (endianness (target-endianness))
+ (text (make-object '.rtl-text bv '()))
+ (dt (make-dynamic-section word-size endianness))
+ ;; This needs to be linked last, because linking other
+ ;; sections adds entries to the string table.
+ (shstrtab (link-string-table)))
+ (link-elf (list text dt shstrtab)
+ #:endianness endianness #:word-size word-size))))
+
+(define (write-objcode objcode port)
+ (let ((bv (objcode->bytecode objcode (target-endianness))))
+ (put-bytevector port (bytecode->elf bv))))
diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm
index 7cc85b7f6..022419e9d 100644
--- a/module/language/objcode/spec.scm
+++ b/module/language/objcode/spec.scm
@@ -22,6 +22,7 @@
#:use-module (system base language)
#:use-module (system vm objcode)
#:use-module (system vm program)
+ #:use-module (language objcode elf)
#:export (objcode))
(define (objcode->value x e opts)
diff --git a/module/scripts/disassemble.scm b/module/scripts/disassemble.scm
index 7dab2dde9..094d65654 100644
--- a/module/scripts/disassemble.scm
+++ b/module/scripts/disassemble.scm
@@ -1,6 +1,6 @@
;;; Disassemble --- Disassemble .go files into something human-readable
-;; Copyright 2005, 2008, 2009, 2011 Free Software Foundation, Inc.
+;; Copyright 2005, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@@ -36,7 +36,7 @@
(define (disassemble . files)
(for-each (lambda (file)
- (asm:disassemble (load-objcode file)))
+ (asm:disassemble (load-thunk-from-file file)))
files))
(define main disassemble)
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index a709c8dd6..a9fdc992d 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -1,6 +1,6 @@
;;; Repl commands
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -490,7 +490,7 @@ Disassemble a compiled procedure."
(define-meta-command (disassemble-file repl file)
"disassemble-file FILE
Disassemble a file."
- (guile:disassemble (load-objcode (->string file))))
+ (guile:disassemble (load-thunk-from-file (->string file))))
;;;
diff --git a/module/system/vm/objcode.scm b/module/system/vm/objcode.scm
index 3ad29880b..f939a5551 100644
--- a/module/system/vm/objcode.scm
+++ b/module/system/vm/objcode.scm
@@ -21,7 +21,6 @@
(define-module (system vm objcode)
#:export (objcode? objcode-meta
bytecode->objcode objcode->bytecode
- load-objcode write-objcode
load-thunk-from-file load-thunk-from-memory
word-size byte-order))