1 /* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 #include <sys/types.h>
34 #include "vm-bootstrap.h"
38 /* The endianness marker in objcode. */
39 #ifdef WORDS_BIGENDIAN
40 # define OBJCODE_ENDIANNESS "BE"
42 # define OBJCODE_ENDIANNESS "LE"
45 #define _OBJCODE_STRINGIFY(x) # x
46 #define OBJCODE_STRINGIFY(x) _OBJCODE_STRINGIFY (x)
48 /* The word size marker in objcode. */
49 #define OBJCODE_WORD_SIZE OBJCODE_STRINGIFY (SIZEOF_VOID_P)
51 /* The objcode magic header. */
52 #define OBJCODE_COOKIE \
53 "GOOF-0.9-" OBJCODE_ENDIANNESS "-" OBJCODE_WORD_SIZE "---"
55 /* The length of the header must be a multiple of 8 bytes. */
56 verify (((sizeof (OBJCODE_COOKIE
) - 1) & 7) == 0);
64 scm_t_bits scm_tc16_objcode
;
67 make_objcode_by_mmap (int fd
)
68 #define FUNC_NAME "make_objcode_by_mmap"
73 SCM sret
= SCM_BOOL_F
;
74 struct scm_objcode
*data
;
76 ret
= fstat (fd
, &st
);
80 if (st
.st_size
<= sizeof (struct scm_objcode
) + strlen (OBJCODE_COOKIE
))
81 scm_misc_error (FUNC_NAME
, "object file too small (~a bytes)",
82 scm_list_1 (SCM_I_MAKINUM (st
.st_size
)));
84 addr
= mmap (0, st
.st_size
, PROT_READ
, MAP_SHARED
, fd
, 0);
85 if (addr
== MAP_FAILED
)
91 if (memcmp (addr
, OBJCODE_COOKIE
, strlen (OBJCODE_COOKIE
)))
93 SCM args
= scm_list_1 (scm_from_locale_stringn
94 (addr
, strlen (OBJCODE_COOKIE
)));
96 (void) munmap (addr
, st
.st_size
);
97 scm_misc_error (FUNC_NAME
, "bad header on object file: ~s", args
);
100 data
= (struct scm_objcode
*)(addr
+ strlen (OBJCODE_COOKIE
));
102 if (data
->len
+ data
->metalen
!= (st
.st_size
- sizeof (*data
) - strlen (OBJCODE_COOKIE
)))
105 (void) munmap (addr
, st
.st_size
);
106 scm_misc_error (FUNC_NAME
, "bad length header (~a, ~a)",
107 scm_list_2 (scm_from_size_t (st
.st_size
),
108 scm_from_uint32 (sizeof (*data
) + data
->len
112 SCM_NEWSMOB3 (sret
, scm_tc16_objcode
, addr
+ strlen (OBJCODE_COOKIE
),
113 SCM_PACK (SCM_BOOL_F
), fd
);
114 SCM_SET_SMOB_FLAGS (sret
, SCM_F_OBJCODE_IS_MMAP
);
116 /* FIXME: we leak ourselves and the file descriptor. but then again so does
118 return scm_permanent_object (sret
);
123 scm_c_make_objcode_slice (SCM parent
, const scm_t_uint8
*ptr
)
124 #define FUNC_NAME "make-objcode-slice"
126 const struct scm_objcode
*data
, *parent_data
;
129 SCM_VALIDATE_OBJCODE (1, parent
);
130 parent_data
= SCM_OBJCODE_DATA (parent
);
132 if (ptr
< parent_data
->base
133 || ptr
>= (parent_data
->base
+ parent_data
->len
+ parent_data
->metalen
134 - sizeof (struct scm_objcode
)))
135 scm_misc_error (FUNC_NAME
, "offset out of bounds (~a vs ~a + ~a + ~a)",
136 scm_list_4 (scm_from_ulong ((unsigned long)ptr
),
137 scm_from_ulong ((unsigned long)parent_data
->base
),
138 scm_from_uint32 (parent_data
->len
),
139 scm_from_uint32 (parent_data
->metalen
)));
142 /* FIXME: We currently generate bytecode where the objcode-meta isn't
143 suitable aligned, which is an issue on some arches (e.g., SPARC). */
144 assert ((((uintptr_t) ptr
) & (__alignof__ (struct scm_objcode
) - 1UL)) == 0);
147 data
= (struct scm_objcode
*)ptr
;
148 if (data
->base
+ data
->len
+ data
->metalen
> parent_data
->base
+ parent_data
->len
+ parent_data
->metalen
)
151 SCM_NEWSMOB2 (ret
, scm_tc16_objcode
, data
, parent
);
152 SCM_SET_SMOB_FLAGS (ret
, SCM_F_OBJCODE_IS_SLICE
);
158 objcode_mark (SCM obj
)
160 return SCM_SMOB_OBJECT_2 (obj
);
168 SCM_DEFINE (scm_objcode_p
, "objcode?", 1, 0, 0,
171 #define FUNC_NAME s_scm_objcode_p
173 return SCM_BOOL (SCM_OBJCODE_P (obj
));
177 SCM_DEFINE (scm_objcode_meta
, "objcode-meta", 1, 0, 0,
180 #define FUNC_NAME s_scm_objcode_meta
182 SCM_VALIDATE_OBJCODE (1, objcode
);
184 if (SCM_OBJCODE_META_LEN (objcode
) == 0)
187 return scm_c_make_objcode_slice (objcode
, (SCM_OBJCODE_BASE (objcode
)
188 + SCM_OBJCODE_LEN (objcode
)));
192 SCM_DEFINE (scm_bytecode_to_objcode
, "bytecode->objcode", 1, 0, 0,
195 #define FUNC_NAME s_scm_bytecode_to_objcode
199 scm_t_array_handle handle
;
200 const scm_t_uint8
*c_bytecode
;
201 struct scm_objcode
*data
;
204 if (scm_is_false (scm_u8vector_p (bytecode
)))
205 scm_wrong_type_arg (FUNC_NAME
, 1, bytecode
);
207 c_bytecode
= scm_u8vector_elements (bytecode
, &handle
, &size
, &increment
);
208 data
= (struct scm_objcode
*)c_bytecode
;
209 SCM_NEWSMOB2 (objcode
, scm_tc16_objcode
, data
, bytecode
);
210 scm_array_handle_release (&handle
);
212 SCM_ASSERT_RANGE (0, bytecode
, size
>= sizeof(struct scm_objcode
));
213 if (data
->len
+ data
->metalen
!= (size
- sizeof (*data
)))
214 scm_misc_error (FUNC_NAME
, "bad u8vector size (~a != ~a)",
215 scm_list_2 (scm_from_size_t (size
),
216 scm_from_uint32 (sizeof (*data
) + data
->len
+ data
->metalen
)));
217 assert (increment
== 1);
218 SCM_SET_SMOB_FLAGS (objcode
, SCM_F_OBJCODE_IS_U8VECTOR
);
220 /* foolishly, we assume that as long as bytecode is around, that c_bytecode
221 will be of the same length; perhaps a bad assumption? */
227 SCM_DEFINE (scm_load_objcode
, "load-objcode", 1, 0, 0,
230 #define FUNC_NAME s_scm_load_objcode
235 SCM_VALIDATE_STRING (1, file
);
237 c_file
= scm_to_locale_string (file
);
238 fd
= open (c_file
, O_RDONLY
);
240 if (fd
< 0) SCM_SYSERROR
;
242 return make_objcode_by_mmap (fd
);
246 SCM_DEFINE (scm_objcode_to_bytecode
, "objcode->bytecode", 1, 0, 0,
249 #define FUNC_NAME s_scm_objcode_to_bytecode
251 scm_t_uint8
*u8vector
;
254 SCM_VALIDATE_OBJCODE (1, objcode
);
256 len
= sizeof(struct scm_objcode
) + SCM_OBJCODE_TOTAL_LEN (objcode
);
257 /* FIXME: Is `gc_malloc' ok here? */
258 u8vector
= scm_gc_malloc (len
, "objcode-u8vector");
259 memcpy (u8vector
, SCM_OBJCODE_DATA (objcode
), len
);
261 return scm_take_u8vector (u8vector
, len
);
265 SCM_DEFINE (scm_write_objcode
, "write-objcode", 2, 0, 0,
266 (SCM objcode
, SCM port
),
268 #define FUNC_NAME s_scm_write_objcode
270 SCM_VALIDATE_OBJCODE (1, objcode
);
271 SCM_VALIDATE_OUTPUT_PORT (2, port
);
273 scm_c_write (port
, OBJCODE_COOKIE
, strlen (OBJCODE_COOKIE
));
274 scm_c_write (port
, SCM_OBJCODE_DATA (objcode
),
275 sizeof (struct scm_objcode
) + SCM_OBJCODE_TOTAL_LEN (objcode
));
277 return SCM_UNSPECIFIED
;
283 scm_bootstrap_objcodes (void)
285 scm_tc16_objcode
= scm_make_smob_type ("objcode", 0);
286 scm_set_smob_mark (scm_tc16_objcode
, objcode_mark
);
287 scm_c_register_extension ("libguile", "scm_init_objcodes",
288 (scm_t_extension_init_func
)scm_init_objcodes
, NULL
);
291 /* Before, we used __BYTE_ORDER, but that is not defined on all
292 systems. So punt and use automake, PDP endianness be damned. */
293 #ifdef WORDS_BIGENDIAN
294 #define SCM_BYTE_ORDER 4321
296 #define SCM_BYTE_ORDER 1234
300 scm_init_objcodes (void)
304 #ifndef SCM_MAGIC_SNARFER
305 #include "libguile/objcodes.x"
308 scm_c_define ("word-size", scm_from_size_t (sizeof(SCM
)));
309 scm_c_define ("byte-order", scm_from_uint16 (SCM_BYTE_ORDER
));