diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index 692cb3684..d95cd02aa 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008, 2009, 2010, 2011 +@c Copyright (C) 2008, 2009, 2010, 2011, 2012 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -800,29 +800,36 @@ objcode)} module. Returns @code{#f} iff @var{obj} is object code, @code{#f} otherwise. @end deffn -@deffn {Scheme Procedure} bytecode->objcode bytecode +@deffn {Scheme Procedure} bytecode->objcode bytecode [endianness] @deffnx {C Function} scm_bytecode_to_objcode (bytecode) Makes a bytecode object from @var{bytecode}, which should be a -bytevector. @xref{Bytevectors}. +bytevector. @xref{Bytevectors}. By default, the embedded length fields +in the bytevector are interpreted in the native byte order. @end deffn -@deffn {Scheme Variable} load-objcode file -@deffnx {C Function} scm_load_objcode (file) +@deffn {Scheme Variable} load-thunk-from-file file +@deffnx {C Function} scm_load_thunk_from_file (file) Load object code from a file named @var{file}. The file will be mapped into memory via @code{mmap}, so this is a very fast operation. -On disk, object code has an sixteen-byte cookie prepended to it, to -prevent accidental loading of arbitrary garbage. +On disk, object code is embedded in ELF, a flexible container format +created for use in UNIX systems. Guile has its own ELF linker and +loader, so it uses the ELF format on all systems. @end deffn @deffn {Scheme Variable} write-objcode objcode file @deffnx {C Function} scm_write_objcode (objcode) -Write object code out to a file, prepending the sixteen-byte cookie. +Embed object code into an ELF container, and write it out to a file. + +This procedure is part of a separate module, @code{(language objcode +elf)}. @end deffn -@deffn {Scheme Variable} objcode->bytecode objcode +@deffn {Scheme Variable} objcode->bytecode objcode [endianness] @deffnx {C Function} scm_objcode_to_bytecode (objcode) -Copy object code out to a bytevector for analysis by Scheme. +Copy object code out to a bytevector for analysis by Scheme. By +default, the length fields in the @code{struct scm_objcode} are +interpreted in the native byte order. @end deffn The following procedure is actually in @code{(system vm program)}, but diff --git a/libguile/objcodes.c b/libguile/objcodes.c index 73422c40c..c2932334b 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -41,8 +41,20 @@ #include "programs.h" #include "objcodes.h" -/* This file contains the loader for Guile's ELF format. It is followed - by the old loader. We'll remove the old loader at some point. */ +/* Before, we used __BYTE_ORDER, but that is not defined on all + systems. So punt and use automake, PDP endianness be damned. */ +#define SCM_BYTE_ORDER_BE 4321 +#define SCM_BYTE_ORDER_LE 1234 + +/* Byte order of the build machine. */ +#ifdef WORDS_BIGENDIAN +#define SCM_BYTE_ORDER SCM_BYTE_ORDER_BE +#else +#define SCM_BYTE_ORDER SCM_BYTE_ORDER_LE +#endif + +/* This file contains the loader for Guile's on-disk format: ELF with + some custom tags in the dynamic segment. */ #if SIZEOF_SCM_T_BITS == 4 #define Elf_Half Elf32_Half @@ -588,202 +600,22 @@ SCM_DEFINE (scm_load_thunk_from_memory, "load-thunk-from-memory", 1, 0, 0, } #undef FUNC_NAME - - -/* SCM_OBJCODE_COOKIE, defined in _scm.h, is a magic value prepended - to objcode on disk but not in memory. - - The length of the header must be a multiple of 8 bytes. */ -verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0); - -/* Endianness and word size of the compilation target. */ -static SCM target_endianness_var = SCM_BOOL_F; -static SCM target_word_size_var = SCM_BOOL_F; - /* * Objcode type */ -/* Endianness of the build machine. */ -#ifdef WORDS_BIGENDIAN -# define NATIVE_ENDIANNESS 'B' -#else -# define NATIVE_ENDIANNESS 'L' -#endif - -/* Return the endianness of the compilation target. */ -static char -target_endianness (void) -{ - if (scm_is_true (target_endianness_var)) - return scm_is_eq (scm_call_0 (scm_variable_ref (target_endianness_var)), - scm_endianness_big) ? 'B' : 'L'; - else - return NATIVE_ENDIANNESS; -} - -/* Return the word size in bytes of the compilation target. */ -static size_t -target_word_size (void) -{ - if (scm_is_true (target_word_size_var)) - return scm_to_size_t (scm_call_0 - (scm_variable_ref (target_word_size_var))); - else - return sizeof (void *); -} - -/* Convert X, which is in byte order ENDIANNESS, to its native +/* Convert X, which is in byte order BYTE_ORDER, to its native representation. */ static inline uint32_t -to_native_order (uint32_t x, char endianness) +to_native_order (uint32_t x, int byte_order) { - if (endianness == NATIVE_ENDIANNESS) + if (byte_order == SCM_BYTE_ORDER) return x; else return bswap_32 (x); } -static void -verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) -#define FUNC_NAME "make_objcode_from_file" -{ - /* The cookie ends with a version of the form M.N, where M is the - major version and N is the minor version. For this Guile to be - able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N - must be less than or equal to SCM_OBJCODE_MINOR_VERSION. Since N - is the last character, we do a strict comparison on all but the - last, then a <= on the last one. */ - if (memcmp (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1)) - { - SCM args = scm_list_1 (scm_from_latin1_stringn - (cookie, strlen (SCM_OBJCODE_COOKIE))); - if (map_fd >= 0) - { - (void) close (map_fd); -#ifdef HAVE_SYS_MMAN_H - (void) munmap (map_addr, st->st_size); -#endif - } - scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); - } - - { - char minor_version = cookie[strlen (SCM_OBJCODE_COOKIE) - 1]; - - if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0]) - { - if (map_fd >= 0) - { - (void) close (map_fd); -#ifdef HAVE_SYS_MMAN_H - (void) munmap (map_addr, st->st_size); -#endif - } - - scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", - scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), - scm_from_latin1_string - (SCM_OBJCODE_MINOR_VERSION_STRING))); - } - } -} -#undef FUNC_NAME - -/* The words in an objcode SCM object are as follows: - - scm_tc7_objcode | type | flags - - the struct scm_objcode C object - - the parent of this objcode: either another objcode, a bytevector, - or, in the case of mmap types, #f - - "native code" -- not currently used. - */ - -static SCM -make_objcode_from_file (int fd) -#define FUNC_NAME "make_objcode_from_file" -{ - int ret; - /* The SCM_OBJCODE_COOKIE is a string literal, and thus has an extra - trailing NUL, hence the - 1. */ - char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1]; - struct stat st; - - ret = fstat (fd, &st); - if (ret < 0) - SCM_SYSERROR; - - if (st.st_size <= sizeof (struct scm_objcode) + sizeof cookie) - scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", - scm_list_1 (SCM_I_MAKINUM (st.st_size))); - -#ifdef HAVE_SYS_MMAN_H - { - char *addr; - struct scm_objcode *data; - - addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); - - if (addr == MAP_FAILED) - { - int errno_save = errno; - (void) close (fd); - errno = errno_save; - SCM_SYSERROR; - } - else - { - memcpy (cookie, addr, sizeof cookie); - data = (struct scm_objcode *) (addr + sizeof cookie); - } - - verify_cookie (cookie, &st, fd, addr); - - - if (data->len + data->metalen - != (st.st_size - sizeof (*data) - sizeof cookie)) - { - size_t total_len = sizeof (*data) + data->len + data->metalen; - - (void) close (fd); - (void) munmap (addr, st.st_size); - - scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", - scm_list_2 (scm_from_size_t (st.st_size), - scm_from_size_t (total_len))); - } - - (void) close (fd); - return scm_permanent_object - (scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0), - (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)), - SCM_BOOL_F_BITS, 0)); - } -#else - { - SCM bv = scm_c_make_bytevector (st.st_size - sizeof cookie); - - if (full_read (fd, cookie, sizeof cookie) != sizeof cookie - || full_read (fd, SCM_BYTEVECTOR_CONTENTS (bv), - SCM_BYTEVECTOR_LENGTH (bv)) != SCM_BYTEVECTOR_LENGTH (bv)) - { - int errno_save = errno; - (void) close (fd); - errno = errno_save; - SCM_SYSERROR; - } - - (void) close (fd); - - verify_cookie (cookie, &st, -1, NULL); - - return scm_bytecode_to_native_objcode (bv); - } -#endif -} -#undef FUNC_NAME - - SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr) #define FUNC_NAME "make-objcode-slice" @@ -848,9 +680,10 @@ SCM_DEFINE (scm_objcode_meta, "objcode-meta", 1, 0, 0, } #undef FUNC_NAME -/* Turn BYTECODE into objcode encoded for ENDIANNESS and WORD_SIZE. */ +/* Wrap BYTECODE in objcode, interpreting its lengths according to + BYTE_ORDER. */ static SCM -bytecode_to_objcode (SCM bytecode, char endianness, size_t word_size) +bytecode_to_objcode (SCM bytecode, int byte_order) #define FUNC_NAME "bytecode->objcode" { size_t size, len, metalen; @@ -866,8 +699,8 @@ bytecode_to_objcode (SCM bytecode, char endianness, size_t word_size) SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode)); data = (struct scm_objcode*)c_bytecode; - len = to_native_order (data->len, endianness); - metalen = to_native_order (data->metalen, endianness); + len = to_native_order (data->len, byte_order); + metalen = to_native_order (data->metalen, byte_order); if (len + metalen != (size - sizeof (*data))) scm_misc_error (FUNC_NAME, "bad bytevector size (~a != ~a)", @@ -881,100 +714,54 @@ bytecode_to_objcode (SCM bytecode, char endianness, size_t word_size) } #undef FUNC_NAME -SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0, - (SCM bytecode), +SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 1, 0, + (SCM bytecode, SCM endianness), "") #define FUNC_NAME s_scm_bytecode_to_objcode { - /* Assume we're called from Scheme, which known that to do with - `target-type'. */ - return bytecode_to_objcode (bytecode, target_endianness (), - target_word_size ()); + int byte_order; + + if (SCM_UNBNDP (endianness)) + byte_order = SCM_BYTE_ORDER; + else if (scm_is_eq (endianness, scm_endianness_big)) + byte_order = SCM_BYTE_ORDER_BE; + else if (scm_is_eq (endianness, scm_endianness_little)) + byte_order = SCM_BYTE_ORDER_LE; + else + scm_wrong_type_arg (FUNC_NAME, 2, endianness); + + return bytecode_to_objcode (bytecode, byte_order); } #undef FUNC_NAME -/* Like `bytecode->objcode', but ignore the `target-type' fluid. This - is useful for native compilation that happens lazily---e.g., direct - calls to this function from libguile itself. */ -SCM -scm_bytecode_to_native_objcode (SCM bytecode) -{ - return bytecode_to_objcode (bytecode, NATIVE_ENDIANNESS, sizeof (void *)); -} - -SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0, - (SCM file), - "") -#define FUNC_NAME s_scm_load_objcode -{ - int fd; - char *c_file; - - SCM_VALIDATE_STRING (1, file); - - c_file = scm_to_locale_string (file); - fd = open (c_file, O_RDONLY | O_CLOEXEC); - free (c_file); - if (fd < 0) SCM_SYSERROR; - - return make_objcode_from_file (fd); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 0, 0, - (SCM objcode), +SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 1, 0, + (SCM objcode, SCM endianness), "") #define FUNC_NAME s_scm_objcode_to_bytecode { - scm_t_uint32 len; + scm_t_uint32 len, meta_len, total_len; + int byte_order; SCM_VALIDATE_OBJCODE (1, objcode); - len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode); + if (SCM_UNBNDP (endianness)) + byte_order = SCM_BYTE_ORDER; + else if (scm_is_eq (endianness, scm_endianness_big)) + byte_order = SCM_BYTE_ORDER_BE; + else if (scm_is_eq (endianness, scm_endianness_little)) + byte_order = SCM_BYTE_ORDER_LE; + else + scm_wrong_type_arg (FUNC_NAME, 2, endianness); + + len = SCM_OBJCODE_LEN (objcode); + meta_len = SCM_OBJCODE_META_LEN (objcode); + + total_len = sizeof (struct scm_objcode); + total_len += to_native_order (len, byte_order); + total_len += to_native_order (meta_len, byte_order); return scm_c_take_gc_bytevector ((scm_t_int8*)SCM_OBJCODE_DATA (objcode), - len, objcode); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0, - (SCM objcode, SCM port), - "") -#define FUNC_NAME s_scm_write_objcode -{ - char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1]; - char endianness, word_size; - size_t total_size; - - SCM_VALIDATE_OBJCODE (1, objcode); - SCM_VALIDATE_OUTPUT_PORT (2, port); - endianness = target_endianness (); - switch (target_word_size ()) - { - case 4: - word_size = '4'; - break; - case 8: - word_size = '8'; - break; - default: - abort (); - } - - memcpy (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE)); - cookie[SCM_OBJCODE_ENDIANNESS_OFFSET] = endianness; - cookie[SCM_OBJCODE_WORD_SIZE_OFFSET] = word_size; - - total_size = - to_native_order (SCM_OBJCODE_LEN (objcode), target_endianness ()) - + to_native_order (SCM_OBJCODE_META_LEN (objcode), target_endianness ()); - - scm_c_write_unlocked (port, cookie, strlen (SCM_OBJCODE_COOKIE)); - scm_c_write_unlocked (port, SCM_OBJCODE_DATA (objcode), - sizeof (struct scm_objcode) - + total_size); - - return SCM_UNSPECIFIED; + total_len, objcode); } #undef FUNC_NAME @@ -995,14 +782,6 @@ scm_bootstrap_objcodes (void) (scm_t_extension_init_func)scm_init_objcodes, NULL); } -/* Before, we used __BYTE_ORDER, but that is not defined on all - systems. So punt and use automake, PDP endianness be damned. */ -#ifdef WORDS_BIGENDIAN -#define SCM_BYTE_ORDER 4321 -#else -#define SCM_BYTE_ORDER 1234 -#endif - void scm_init_objcodes (void) { @@ -1012,11 +791,6 @@ scm_init_objcodes (void) scm_c_define ("word-size", scm_from_size_t (sizeof(SCM))); scm_c_define ("byte-order", scm_from_uint16 (SCM_BYTE_ORDER)); - - target_endianness_var = scm_c_public_variable ("system base target", - "target-endianness"); - target_word_size_var = scm_c_public_variable ("system base target", - "target-word-size"); } /* diff --git a/libguile/objcodes.h b/libguile/objcodes.h index 83ab79394..6ac333fa4 100644 --- a/libguile/objcodes.h +++ b/libguile/objcodes.h @@ -64,13 +64,10 @@ SCM_API SCM scm_load_thunk_from_file (SCM filename); SCM_API SCM scm_load_thunk_from_memory (SCM bv); SCM_API SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr); -SCM_API SCM scm_load_objcode (SCM file); SCM_API SCM scm_objcode_p (SCM obj); SCM_API SCM scm_objcode_meta (SCM objcode); -SCM_API SCM scm_bytecode_to_objcode (SCM bytecode); -SCM_INTERNAL SCM scm_bytecode_to_native_objcode (SCM bytecode); -SCM_API SCM scm_objcode_to_bytecode (SCM objcode); -SCM_API SCM scm_write_objcode (SCM objcode, SCM port); +SCM_API SCM scm_bytecode_to_objcode (SCM bytecode, SCM endianness); +SCM_API SCM scm_objcode_to_bytecode (SCM objcode, SCM endianness); SCM_INTERNAL void scm_i_objcode_print (SCM objcode, SCM port, scm_print_state *pstate); diff --git a/libguile/vm.c b/libguile/vm.c index 0d9aa4029..c26447028 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -1046,9 +1046,8 @@ SCM_DEFINE (scm_call_with_vm, "call-with-vm", 2, 0, 1, SCM scm_load_compiled_with_vm (SCM file) { - SCM program = scm_make_program (scm_load_objcode (file), - SCM_BOOL_F, SCM_BOOL_F); - + SCM program = scm_load_thunk_from_file (file); + return scm_c_vm_run (scm_the_vm (), program, NULL, 0); } @@ -1072,7 +1071,7 @@ make_boot_program (void) bp->metalen = 0; u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp, bp_size, SCM_BOOL_F); - ret = scm_make_program (scm_bytecode_to_native_objcode (u8vec), + ret = scm_make_program (scm_bytecode_to_objcode (u8vec, SCM_UNDEFINED), SCM_BOOL_F, SCM_BOOL_F); SCM_SET_CELL_WORD_0 (ret, (SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_BOOT)); 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)) diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test index 52bc7e1a7..ddbe2eeac 100644 --- a/test-suite/tests/asm-to-bytecode.test +++ b/test-suite/tests/asm-to-bytecode.test @@ -22,7 +22,9 @@ #:use-module (test-suite lib) #:use-module (system vm instruction) #:use-module (system vm objcode) + #:use-module (system vm elf) #:use-module (system base target) + #:use-module (language objcode elf) #:use-module (language assembly) #:use-module (language assembly compile-bytecode)) @@ -167,20 +169,12 @@ (nop) (nop) (nop) (nop) (nop)) #f))) - (write-objcode (bytecode->objcode b) p) - (let ((cookie (make-bytevector %objcode-cookie-size)) - (expected (format #f "GOOF----~a-~a" - (cond ((eq? endian (endianness little)) - "LE") - ((eq? endian (endianness big)) - "BE") - (else - (error "unknown endianness" - endian))) - word-size))) - (bytevector-copy! (get-objcode) 0 cookie 0 - %objcode-cookie-size) - (string=? (utf8->string cookie) expected))))))))) + (write-objcode (bytecode->objcode b (target-endianness)) p) + (let* ((bv (get-objcode))) + (and=> (parse-elf bv) + (lambda (elf) + (and (equal? (elf-byte-order elf) endian) + (equal? (elf-word-size elf) word-size)))))))))))) (with-test-prefix "cross-compilation" @@ -202,7 +196,7 @@ (make-int8 77) (return)) #f)) - (o (bytecode->objcode b))) + (o (bytecode->objcode b (target-endianness)))) (with-target "fcpu-unknown-gnu1.0" (lambda () (write-objcode o p))))))))