mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

instead of our custom .go format, use elf

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2012-06-22 13:35:55 +02:00
parent afc74c2920
commit b8bc86bce1
12 changed files with 192 additions and 325 deletions
Download patch file Download diff file Expand all files Collapse all files

27
doc/ref/compiler.texi
View file

@ -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

338
libguile/objcodes.c
View file

@ -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");
}
/*

7
libguile/objcodes.h
View file

@ -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);

5
libguile/vm.c
View file

@ -1046,8 +1046,7 @@ 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));

3
module/Makefile.am
View file

@ -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

7
module/language/bytecode/spec.scm
View file

@ -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"

94
module/language/objcode/elf.scm Normal file
View file

@ -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))))

1
module/language/objcode/spec.scm
View file

@ -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)

4
module/scripts/disassemble.scm
View file

@ -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)

4
module/system/repl/command.scm
View file

@ -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))))
;;;

1
module/system/vm/objcode.scm
View file

@ -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))

24
test-suite/tests/asm-to-bytecode.test
View file

@ -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))))))))