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.

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
+@deffn {Scheme Variable} load-thunk-from-file file
-@deffnx {C Function} scm_load_objcode (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
+On disk, object code is embedded in ELF, a flexible container format
-prevent accidental loading of arbitrary garbage.
+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

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
+/* Before, we used __BYTE_ORDER, but that is not defined on all
-   by the old loader.  We'll remove the old loader at some point.  */
+   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.  */
+/* Convert X, which is in byte order BYTE_ORDER, to its native
-#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
    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);
+  len = to_native_order (data->len, byte_order);
-  metalen = to_native_order (data->metalen, endianness);
+  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_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 1, 0,
-	    (SCM bytecode),
+	    (SCM bytecode, SCM endianness),
 	    "")
 #define FUNC_NAME s_scm_bytecode_to_objcode
 {
-  /* Assume we're called from Scheme, which known that to do with
+  int byte_order;
-     `target-type'.  */
+
-  return bytecode_to_objcode (bytecode, target_endianness (),
+  if (SCM_UNBNDP (endianness))
-			      target_word_size ());
+    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
+SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 1, 0,
-   is useful for native compilation that happens lazily---e.g., direct
+	    (SCM objcode, SCM endianness),
-   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),
 	    "")
 #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);
+                                   total_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;
 }
 #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");
 }
 
 /*

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_API SCM scm_bytecode_to_objcode (SCM bytecode, SCM endianness);
-SCM_INTERNAL SCM scm_bytecode_to_native_objcode (SCM bytecode);
+SCM_API SCM scm_objcode_to_bytecode (SCM objcode, SCM endianness);
-SCM_API SCM scm_objcode_to_bytecode (SCM objcode);
-SCM_API SCM scm_write_objcode (SCM objcode, SCM port);
 
 SCM_INTERNAL void scm_i_objcode_print (SCM objcode, SCM port,
                                        scm_print_state *pstate);

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 program = scm_load_thunk_from_file (file);
-                                  SCM_BOOL_F, SCM_BOOL_F);
+
-  
   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));
 

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

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"

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

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)

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)

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

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

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)
+              (write-objcode (bytecode->objcode b (target-endianness)) p)
-              (let ((cookie   (make-bytevector %objcode-cookie-size))
+              (let* ((bv (get-objcode)))
-                    (expected (format #f "GOOF----~a-~a"
+                (and=> (parse-elf bv)
-                                      (cond ((eq? endian (endianness little))
+                       (lambda (elf)
-                                             "LE")
+                         (and (equal? (elf-byte-order elf) endian)
-                                            ((eq? endian (endianness big))
+                              (equal? (elf-word-size elf) word-size))))))))))))
-                                             "BE")
-                                            (else
-                                             (error "unknown endianness"
-                                                    endian)))
-                                      word-size)))
-                (bytevector-copy! (get-objcode) 0 cookie 0
-                                  %objcode-cookie-size)
-                (string=? (utf8->string cookie) expected)))))))))
 
 (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))))))))