diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-11-21 22:08:22 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-11-22 00:22:46 +0100 |
commit | de2c0a10fef8322b3c11acd6d1c149473846ceb8 (patch) | |
tree | 005da02843191915b7f04bb88f8559849a0407eb /libguile/objcodes.c | |
parent | e0a9f02224cdcf0e8e24616038aca905d31b60a7 (diff) | |
download | guile-de2c0a10fef8322b3c11acd6d1c149473846ceb8.tar.gz |
Complete cross-compilation support.
* module/system/base/target.scm (%target-endianness, %target-word-size):
New fluids.
(%native-word-size): New variable.
(with-target): Set these fluids.
(cpu-endianness, cpu-word-size, triplet-cpu, triplet-vendor,
triplet-os): New procedures.
(target-cpu, target-vendor, target-os): Use them.
(target-endianness, target-word-size): Refer to the corresponding
fluid.
* libguile/objcodes.c (target_endianness_var, target_word_size_var): New
global variables.
(NATIVE_ENDIANNESS): New macro.
(target_endianness, target_word_size, to_native_order): New functions.
(make_objcode_from_file): Use `scm_bytecode_to_native_objcode' instead
of `scm_bytecode_to_objcode'.
(bytecode_to_objcode): New function, based on `scm_bytecode_to_objcode',
with the addition of an `endianness' and `word_size' parameters.
(scm_bytecode_to_objcode): Use it.
(scm_bytecode_to_native_objcode): New function.
(scm_write_objcode): Use `target_word_size' and `target_endianness'.
Convert OBJCODE's len and meta-len to native byte order.
(scm_init_objcodes): Initialize `target_endianness_var' and
`target_word_size_var'.
* libguile/objcodes.h (scm_bytecode_to_native_objcode): New declaration.
* libguile/vm.c (really_make_boot_program): Use
`scm_bytecode_to_native_objcode' instead of `scm_bytecode_to_objcode'.
* test-suite/tests/asm-to-bytecode.test (%objcode-cookie-size): New
variable.
(test-target): New procedure.
("cross-compilation"): Add `test-target' calls and the "unknown
target" test.
Diffstat (limited to 'libguile/objcodes.c')
-rw-r--r-- | libguile/objcodes.c | 130 |
1 files changed, 100 insertions, 30 deletions
diff --git a/libguile/objcodes.c b/libguile/objcodes.c index 6223362f4..536094fe2 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -32,6 +32,7 @@ #include <sys/types.h> #include <assert.h> #include <alignof.h> +#include <byteswap.h> #include <full-read.h> @@ -45,11 +46,55 @@ 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 + representation. */ +static inline uint32_t +to_native_order (uint32_t x, char endianness) +{ + if (endianness == NATIVE_ENDIANNESS) + 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" @@ -183,7 +228,7 @@ make_objcode_from_file (int fd) verify_cookie (cookie, &st, -1, NULL); - return scm_bytecode_to_objcode (bv); + return scm_bytecode_to_native_objcode (bv); } #endif } @@ -254,12 +299,12 @@ SCM_DEFINE (scm_objcode_meta, "objcode-meta", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0, - (SCM bytecode), - "") -#define FUNC_NAME s_scm_bytecode_to_objcode +/* Turn BYTECODE into objcode encoded for ENDIANNESS and WORD_SIZE. */ +static SCM +bytecode_to_objcode (SCM bytecode, char endianness, size_t word_size) +#define FUNC_NAME "bytecode->objcode" { - size_t size; + size_t size, len, metalen; const scm_t_uint8 *c_bytecode; struct scm_objcode *data; @@ -268,14 +313,17 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0, size = SCM_BYTEVECTOR_LENGTH (bytecode); c_bytecode = (const scm_t_uint8*)SCM_BYTEVECTOR_CONTENTS (bytecode); - + SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode)); data = (struct scm_objcode*)c_bytecode; - if (data->len + data->metalen != (size - sizeof (*data))) + len = to_native_order (data->len, endianness); + metalen = to_native_order (data->metalen, endianness); + + if (len + metalen != (size - sizeof (*data))) scm_misc_error (FUNC_NAME, "bad bytevector size (~a != ~a)", scm_list_2 (scm_from_size_t (size), - scm_from_uint32 (sizeof (*data) + data->len + data->metalen))); + scm_from_uint32 (sizeof (*data) + len + metalen))); /* foolishly, we assume that as long as bytecode is around, that c_bytecode will be of the same length; perhaps a bad assumption? */ @@ -284,6 +332,27 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0, + (SCM bytecode), + "") +#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 ()); +} +#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), "") @@ -327,40 +396,36 @@ SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0, "") #define FUNC_NAME s_scm_write_objcode { - static SCM target_endianness_var = SCM_BOOL_F; - static SCM target_word_size_var = SCM_BOOL_F; - char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1]; - char endianness; - char word_size; + char endianness, word_size; + size_t total_size; SCM_VALIDATE_OBJCODE (1, objcode); SCM_VALIDATE_OUTPUT_PORT (2, port); - - if (scm_is_false (target_endianness_var)) - target_endianness_var = - scm_c_public_variable ("system base target", "target-endianness"); - if (scm_is_false (target_word_size_var)) - target_word_size_var = - scm_c_public_variable ("system base target", "target-word-size"); - - endianness = - scm_is_eq (scm_call_0 (scm_variable_ref (target_endianness_var)), - scm_endianness_big) ? 'B' : 'L'; - switch (scm_to_int (scm_call_0 (scm_variable_ref (target_word_size_var)))) + endianness = target_endianness (); + switch (target_word_size ()) { - case 4: word_size = '4'; break; - case 8: word_size = '8'; break; - default: abort (); + 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 (port, cookie, strlen (SCM_OBJCODE_COOKIE)); scm_c_write (port, SCM_OBJCODE_DATA (objcode), - sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode)); + sizeof (struct scm_objcode) + total_size); return SCM_UNSPECIFIED; } @@ -400,6 +465,11 @@ 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"); } /* |