[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-308-g63316ab
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-308-g63316ab |
|
Date: |
Tue, 05 Jun 2012 20:57:43 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=63316ab0f0067edb7e5e3d3d21894312d3d0544c
The branch, wip-rtl has been updated
via 63316ab0f0067edb7e5e3d3d21894312d3d0544c (commit)
from d8647aaddd13f96499eb1cf0a647fc1430f12c29 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 63316ab0f0067edb7e5e3d3d21894312d3d0544c
Author: Andy Wingo <address@hidden>
Date: Tue Jun 5 22:57:11 2012 +0200
constant relocations are working
* libguile/vm-engine.c (rtl_vm_engine): Renumber ops. Mark static-set!
as an LO32, meaning that the assembler should take an offset in words
as well. Reorder the string opcodes.
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): Handle
LO32.
* module/system/vm/rtl.scm (intern-constant): Symbols are made from
strings, not stringbufs.
(reset-asm-start!): Rename from finish-instruction.
(emit-label): Do a reset-asm-start!.
(record-far-label-reference): Take an optional offset argument.
(emit-non-immediate): New helper.
(assembler): Rename from emitter. Remove support for automatic
constant interning. Add support for LO32.
(assemblers): Rename from emitters.
(define-assembler): Rename from define-emitter.
(define-macro-assembler): New helper.
(load-constant, init-non-immediate, init-string, init-symbol)
(init-keyword, init-number): New macro-instructions.
(disassembler): Add LO32 support.
(link-dynamic-section): Consider the rw-init to be a label and not a
section.
(write-constant-reference): Assume the non-immediate is in the table.
Use the new init-non-immediate macro-instruction.
(write-string): Use init-string.
(write-symbol): Use init-symbol.
(write-keyword): Use init-keyword.
(write-number): Use init-number.
(emit-init-constants): Rename from link-constants. Instead, emit into
the text section.
(link-data): Adapt to emit-init-constants change.
(link-objects): Adapt to emit text after constants.
-----------------------------------------------------------------------
Summary of changes:
libguile/instructions.c | 1 +
libguile/vm-engine.c | 222 +++++++++++++++++++++------------------------
module/system/vm/rtl.scm | 204 +++++++++++++++++++++++++-----------------
3 files changed, 228 insertions(+), 199 deletions(-)
diff --git a/libguile/instructions.c b/libguile/instructions.c
index d50290f..11004fc 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -59,6 +59,7 @@ struct scm_instruction {
M(N32) /* Non-immediate. */ \
M(S32) /* Scheme value (indirected). */ \
M(L32) /* Label. */ \
+ M(LO32) /* Label with offset. */ \
M(X8_U24) \
M(X8_U12_U12) \
M(X8_R24) \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index e3708d8..b8dc76f 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2065,7 +2065,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Store a SCM value into memory, OFFSET 32-bit words away from the
* current instruction pointer. OFFSET is a signed value.
*/
- VM_DEFINE_OP (52, static_set, "static-set!", OP2 (U8_U24, L32))
+ VM_DEFINE_OP (52, static_set, "static-set!", OP2 (U8_U24, LO32))
{
scm_t_uint32 src;
scm_t_int32 offset;
@@ -2128,7 +2128,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Resolve SYM in MOD, and place the resulting variable in DST.
*/
- VM_DEFINE_OP (54, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (53, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, mod, sym;
@@ -2146,7 +2146,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* nonzero, resolve the public interface, otherwise use the private
* interface.
*/
- VM_DEFINE_OP (55, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) |
OP_DST)
+ VM_DEFINE_OP (54, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) |
OP_DST)
{
scm_t_uint8 dst, name, public;
SCM mod;
@@ -2167,7 +2167,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Look up a binding for SYM in the current module, creating it if
* necessary. Set its value to VAL.
*/
- VM_DEFINE_OP (56, define, "define", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (55, define, "define", OP1 (U8_U12_U12))
{
scm_t_uint16 sym, val;
SCM_UNPACK_RTL_12_12 (op, sym, val);
@@ -2195,7 +2195,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* an error if it is unbound, unbox it into DST, and cache the
* resolved variable so that we will hit the cache next time.
*/
- VM_DEFINE_OP (57, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32)
| OP_DST)
+ VM_DEFINE_OP (56, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32)
| OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
@@ -2242,7 +2242,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Like toplevel-ref, except MOD-OFFSET points at the name of a module
* instead of the module itself.
*/
- VM_DEFINE_OP (58, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) |
OP_DST)
+ VM_DEFINE_OP (57, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) |
OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
@@ -2304,7 +2304,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* return/values. If FLAGS is nonzero, mark the prompt as escape-only,
* indicating that no continuation need be reified.
*/
- VM_DEFINE_OP (59, prompt, "prompt", OP3 (U8_U24, U32, U8_L24))
+ VM_DEFINE_OP (58, prompt, "prompt", OP3 (U8_U24, U32, U8_L24))
#if 0
{
scm_t_uint32 tag, return_loc;
@@ -2338,7 +2338,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* the compiler should have inserted checks that they wind and unwind
* procs are thunks, if it could not prove that to be the case.
*/
- VM_DEFINE_OP (60, wind, "wind", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (59, wind, "wind", OP1 (U8_U12_U12))
{
scm_t_uint16 winder, unwinder;
SCM_UNPACK_RTL_12_12 (op, winder, unwinder);
@@ -2353,7 +2353,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* VAL1, etc are 24-bit values, in the lower 24 bits of their words.
* The upper 8 bits are 0.
*/
- VM_DEFINE_OP (61, abort, "abort", OP2 (U8_U24, X8_R24))
+ VM_DEFINE_OP (60, abort, "abort", OP2 (U8_U24, X8_R24))
#if 0
{
scm_t_uint32 tag, nvalues;
@@ -2376,7 +2376,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* A normal exit from the dynamic extent of an expression. Pop the top
* entry off of the dynamic stack.
*/
- VM_DEFINE_OP (62, unwind, "unwind", OP1 (U8_X24))
+ VM_DEFINE_OP (61, unwind, "unwind", OP1 (U8_X24))
{
scm_dynstack_pop (¤t_thread->dynstack);
NEXT (1);
@@ -2388,7 +2388,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* allocated in a continguous range on the stack, starting from
* FLUID-BASE. The values do not have this restriction.
*/
- VM_DEFINE_OP (63, wind_fluids, "wind-fluids", OP2 (U8_U24, X8_R24))
+ VM_DEFINE_OP (62, wind_fluids, "wind-fluids", OP2 (U8_U24, X8_R24))
#if 0
{
scm_t_uint32 fluid_base, n;
@@ -2410,7 +2410,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Leave the dynamic extent of a with-fluids expression, restoring the
* fluids to their previous values.
*/
- VM_DEFINE_OP (64, unwind_fluids, "unwind-fluids", OP1 (U8_X24))
+ VM_DEFINE_OP (63, unwind_fluids, "unwind-fluids", OP1 (U8_X24))
{
/* This function must not allocate. */
scm_dynstack_unwind_fluids (¤t_thread->dynstack,
@@ -2422,7 +2422,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Reference the fluid in SRC, and place the value in DST.
*/
- VM_DEFINE_OP (65, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (64, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
size_t num;
@@ -2455,7 +2455,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the value of the fluid in DST to the value in SRC.
*/
- VM_DEFINE_OP (66, fluid_set, "fluid-set", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (65, fluid_set, "fluid-set", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
size_t num;
@@ -2484,37 +2484,50 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Strings, symbols, and keywords
*/
- /* make-keyword dst:12 src:12
+ /* string-length dst:12 src:12
*
- * Make a keyword from the symbol in SRC, and store it in DST.
+ * Store the length of the string in SRC in DST.
*/
- VM_DEFINE_OP (67, make_keyword, "make-keyword", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (66, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
{
- scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
- SYNC_IP ();
- LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
- NEXT (1);
+ ARGS1 (str);
+ if (SCM_LIKELY (scm_is_string (str)))
+ RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
+ else
+ {
+ SYNC_IP ();
+ RETURN (scm_string_length (str));
+ }
}
- /* make-symbol dst:12 src:12
+ /* string-ref dst:8 src:8 idx:8
*
- * Make a symbol from the string in SRC, and store it in DST.
+ * Fetch the character at position IDX in the string in SRC, and store
+ * it in DST.
*/
- VM_DEFINE_OP (68, make_symbol, "make-symbol", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (67, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
- scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
- SYNC_IP ();
- LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
- NEXT (1);
+ scm_t_signed_bits i = 0;
+ ARGS2 (str, idx);
+ if (SCM_LIKELY (scm_is_string (str)
+ && SCM_I_INUMP (idx)
+ && ((i = SCM_I_INUM (idx)) >= 0)
+ && i < scm_i_string_length (str)))
+ RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
+ else
+ {
+ SYNC_IP ();
+ RETURN (scm_string_ref (str, idx));
+ }
}
+ /* No string-set! instruction, as there is no good fast path there. */
+
/* string-to-number dst:12 src:12
*
* Parse a string in SRC to a number, and store in DST.
*/
- VM_DEFINE_OP (69, string_to_number, "string->number", OP1 (U8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (68, string_to_number, "string->number", OP1 (U8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, src;
@@ -2530,7 +2543,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Parse a string in SRC to a symbol, and store in DST.
*/
- VM_DEFINE_OP (70, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (69, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, src;
@@ -2540,46 +2553,19 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
NEXT (1);
}
- /* string-length dst:12 src:12
+ /* symbol->keyword dst:12 src:12
*
- * Store the length of the string in SRC in DST.
- */
- VM_DEFINE_OP (71, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
- {
- ARGS1 (str);
- if (SCM_LIKELY (scm_is_string (str)))
- RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
- else
- {
- SYNC_IP ();
- RETURN (scm_string_length (str));
- }
- }
-
- /* string-ref dst:8 src:8 idx:8
- *
- * Fetch the character at position IDX in the string in SRC, and store
- * it in DST.
+ * Make a keyword from the symbol in SRC, and store it in DST.
*/
- VM_DEFINE_OP (72, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (70, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) |
OP_DST)
{
- scm_t_signed_bits i = 0;
- ARGS2 (str, idx);
- if (SCM_LIKELY (scm_is_string (str)
- && SCM_I_INUMP (idx)
- && ((i = SCM_I_INUM (idx)) >= 0)
- && i < scm_i_string_length (str)))
- RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
- else
- {
- SYNC_IP ();
- RETURN (scm_string_ref (str, idx));
- }
+ scm_t_uint16 dst, src;
+ SCM_UNPACK_RTL_12_12 (op, dst, src);
+ SYNC_IP ();
+ LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
+ NEXT (1);
}
- /* No string-set! instruction, as there is no good fast path there. */
-
-
/*
@@ -2590,7 +2576,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Cons CAR and CDR, and store the result in DST.
*/
- VM_DEFINE_OP (73, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (71, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
RETURN (scm_cons (x, y));
@@ -2600,7 +2586,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the car of SRC in DST.
*/
- VM_DEFINE_OP (74, car, "car", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (72, car, "car", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "car");
@@ -2611,7 +2597,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the cdr of SRC in DST.
*/
- VM_DEFINE_OP (75, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (73, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "cdr");
@@ -2622,7 +2608,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the car of DST to SRC.
*/
- VM_DEFINE_OP (76, set_car, "set-car!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (74, set_car, "set-car!", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
SCM x, y;
@@ -2638,7 +2624,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the cdr of DST to SRC.
*/
- VM_DEFINE_OP (77, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (75, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
SCM x, y;
@@ -2661,7 +2647,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Add A to B, and place the result in DST.
*/
- VM_DEFINE_OP (78, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (76, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (+, scm_sum);
}
@@ -2670,7 +2656,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Add 1 to the value in SRC, and place the result in DST.
*/
- VM_DEFINE_OP (79, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (77, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
@@ -2696,7 +2682,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Subtract B from A, and place the result in DST.
*/
- VM_DEFINE_OP (80, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (78, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (-, scm_difference);
}
@@ -2705,7 +2691,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Subtract 1 from SRC, and place the result in DST.
*/
- VM_DEFINE_OP (81, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (79, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
@@ -2731,7 +2717,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Multiply A and B, and place the result in DST.
*/
- VM_DEFINE_OP (82, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (80, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2742,7 +2728,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the result in DST.
*/
- VM_DEFINE_OP (83, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (81, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2753,7 +2739,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the quotient in DST.
*/
- VM_DEFINE_OP (84, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (82, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2764,7 +2750,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the remainder in DST.
*/
- VM_DEFINE_OP (85, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (83, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2775,7 +2761,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the modulo of A by B in DST.
*/
- VM_DEFINE_OP (86, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (84, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2786,7 +2772,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Shift A arithmetically by B bits, and place the result in DST.
*/
- VM_DEFINE_OP (87, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (85, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2819,7 +2805,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise AND of A and B into DST.
*/
- VM_DEFINE_OP (88, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (86, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2832,7 +2818,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise inclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (89, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (87, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2845,7 +2831,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise exclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (90, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (88, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2858,7 +2844,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the length of the vector in SRC in DST.
*/
- VM_DEFINE_OP (91, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (89, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (vect);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
@@ -2875,7 +2861,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fetch the item at position IDX in the vector in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (92, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (90, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (vect, idx);
@@ -2896,7 +2882,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fill DST with the item IDX elements into the vector at SRC. Useful
* for building data types using vectors.
*/
- VM_DEFINE_OP (93, constant_vector_ref, "constant-vector-ref", OP1
(U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (91, constant_vector_ref, "constant-vector-ref", OP1
(U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM v;
@@ -2915,7 +2901,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (94, vector_set, "vector-set", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (92, vector_set, "vector-set", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx_var, src;
SCM vect, idx, val;
@@ -2950,7 +2936,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (95, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (93, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
VM_VALIDATE_STRUCT (obj, "struct_vtable");
@@ -2964,7 +2950,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* the locals given by INIT0.... The format of INIT0... is as in the
* "call" opcode: unsigned 24-bit values, with 0 in the high byte.
*/
- VM_DEFINE_OP (96, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24))
+ VM_DEFINE_OP (94, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24))
#if 0
{
scm_t_uint16 dst, vtable_r;
@@ -3007,7 +2993,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fetch the item at slot IDX in the struct in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (97, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (95, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (obj, pos);
@@ -3041,7 +3027,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store SRC into the struct DST at slot IDX.
*/
- VM_DEFINE_OP (98, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (96, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM obj, pos, val;
@@ -3082,7 +3068,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (99, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (97, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
if (SCM_INSTANCEP (obj))
@@ -3097,7 +3083,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* DST. Unlike struct-ref, IDX is an 8-bit immediate value, not an
* index into the stack.
*/
- VM_DEFINE_OP (100, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (98, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
@@ -3111,7 +3097,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Store SRC into slot IDX of the struct in DST. Unlike struct-set!,
* IDX is an 8-bit immediate value, not an index into the stack.
*/
- VM_DEFINE_OP (101, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (99, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
@@ -3132,7 +3118,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* from the instruction pointer, and store into DST. LEN is a byte
* length. OFFSET is signed.
*/
- VM_DEFINE_OP (102, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8,
N32, U32) | OP_DST)
+ VM_DEFINE_OP (100, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8,
N32, U32) | OP_DST)
{
scm_t_uint8 dst, type, shape;
scm_t_int32 offset;
@@ -3152,7 +3138,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Make a new array SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (103, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (101, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, type, fill, bounds;
SCM_UNPACK_RTL_12_12 (op, dst, type);
@@ -3250,42 +3236,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
} while (0)
- VM_DEFINE_OP (104, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (102, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
- VM_DEFINE_OP (105, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (103, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s8, s8, int8, 1);
- VM_DEFINE_OP (106, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (104, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
- VM_DEFINE_OP (107, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (105, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
- VM_DEFINE_OP (108, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (106, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
#else
BV_INT_REF (u32, uint32, 4);
#endif
- VM_DEFINE_OP (109, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (107, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
#else
BV_INT_REF (s32, int32, 4);
#endif
- VM_DEFINE_OP (110, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (108, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (u64, uint64, 8);
- VM_DEFINE_OP (111, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (109, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (s64, int64, 8);
- VM_DEFINE_OP (112, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (110, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f32, ieee_single, float, 4);
- VM_DEFINE_OP (113, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (111, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f64, ieee_double, double, 8);
/* bv-u8-set! dst:8 idx:8 src:8
@@ -3389,42 +3375,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
NEXT (1); \
} while (0)
- VM_DEFINE_OP (114, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (112, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
- VM_DEFINE_OP (115, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (113, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
- VM_DEFINE_OP (116, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (114, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
- VM_DEFINE_OP (117, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (115, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN,
SCM_T_INT16_MAX, 2);
- VM_DEFINE_OP (118, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (116, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
#else
BV_INT_SET (u32, uint32, 4);
#endif
- VM_DEFINE_OP (119, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (117, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN,
SCM_T_INT32_MAX, 4);
#else
BV_INT_SET (s32, int32, 4);
#endif
- VM_DEFINE_OP (120, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (118, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (u64, uint64, 8);
- VM_DEFINE_OP (121, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (119, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (s64, int64, 8);
- VM_DEFINE_OP (122, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (120, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f32, ieee_single, float, 4);
- VM_DEFINE_OP (123, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (121, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f64, ieee_double, double, 8);
END_DISPATCH_SWITCH;
diff --git a/module/system/vm/rtl.scm b/module/system/vm/rtl.scm
index a98b749..ae20032 100644
--- a/module/system/vm/rtl.scm
+++ b/module/system/vm/rtl.scm
@@ -71,9 +71,6 @@
(define-inlinable (immediate? x)
(not (zero? (logand (object-address x) 6))))
-(define-inlinable (static? x)
- (or (pair? x) (vector? x))) ; (stringbuf? x)
-
(define (intern-stringbuf archive string)
(let ((table (archive-stringbufs archive)))
(cond
@@ -99,7 +96,7 @@
(intern-constant archive (vector-ref obj i))
(lp (1+ i)))))
((symbol? obj)
- (intern-stringbuf archive (symbol->string obj)))
+ (intern-constant archive (symbol->string obj)))
((string? obj)
(intern-stringbuf archive obj))
((keyword? obj)
@@ -183,7 +180,11 @@
(define-inlinable (make-reloc type label base word)
(list type label base word))
+(define-inlinable (reset-asm-start! asm)
+ (set-asm-start! asm (+ (asm-idx asm) (asm-written asm))))
+
(define (emit-label asm label)
+ (reset-asm-start! asm)
(set-asm-labels! asm (acons label (asm-start asm) (asm-labels asm))))
(define (emit-exported-label asm label)
@@ -195,42 +196,23 @@
(reloc (make-reloc 'x8-s24 label start (- pos start))))
(set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
-(define (record-static-reference asm obj)
- (let* ((label (cond
- ((symbol? obj) (intern-stringbuf (asm-archive asm)
- (symbol->string obj)))
- ((pair? obj) (intern-constant (asm-archive asm) obj))
- ((vector? obj) (intern-constant (asm-archive asm) obj))
- (else (error "not static obj" obj))))
- (start (asm-start asm))
+(define* (record-far-label-reference asm label #:optional (offset 0))
+ (let* ((start (- (asm-start asm) offset))
(pos (asm-pos asm))
(reloc (make-reloc 's32 label start (- pos start))))
(set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
-(define (record-indirect-reference asm obj)
- (let* ((label (cond
- ((or (immediate? obj) (static? obj))
- (error "not indirect obj" obj))
- (else (intern-constant (asm-archive asm) obj))))
- (start (asm-start asm))
- (pos (asm-pos asm))
- (reloc (make-reloc 's32 label start (- pos start))))
- (set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
-
-(define (record-far-label-reference asm label)
- (let* ((start (asm-start asm))
- (pos (asm-pos asm))
- (reloc (make-reloc 's32 label start (- pos start))))
- (set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
-
-(define-inlinable (finish-instruction asm)
- (set-asm-start! asm (+ (asm-idx asm) (asm-written asm))))
+;; Returns a label.
+(define (emit-non-immediate asm obj)
+ (when (immediate? obj)
+ (error "expected a non-immediate" obj))
+ (intern-constant (asm-archive asm) obj))
(eval-when (expand compile load eval)
(define (id-append ctx a b)
(datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b)))))
-(define-syntax emitter
+(define-syntax assembler
(lambda (x)
(define-syntax op-case
(lambda (x)
@@ -295,15 +277,19 @@
(emit asm (ash (object-address imm) -32))
(emit asm (logand (object-address imm) (1- (ash 1 32)))))
((B32))
- ((N32 obj)
- (record-static-reference asm obj)
+ ((N32 label)
+ (record-far-label-reference asm label)
(emit asm 0))
- ((S32 obj)
- (record-indirect-reference asm obj)
+ ((S32 label)
+ (record-far-label-reference asm label)
(emit asm 0))
((L32 label)
(record-far-label-reference asm label)
(emit asm 0))
+ ((LO32 label offset)
+ (record-far-label-reference asm label
+ (* offset (/ (asm-word-size asm) 4)))
+ (emit asm 0))
((X8_U24 a)
(emit asm (pack-u8-u24 0 a)))
((X8_U12_U12 a b)
@@ -334,20 +320,21 @@
(syntax->datum #'(word* ...)))))
#'(lambda (asm formal0 ... formal* ... ...)
(unless (asm? asm) (error "not an asm"))
+ (reset-asm-start! asm)
code0 ...
code* ... ...
- (finish-instruction asm)))))))
+ ))))))
-(define emitters (make-hash-table))
+(define assemblers (make-hash-table))
-(define-syntax define-emitter
+(define-syntax define-assembler
(lambda (x)
(syntax-case x ()
((_ name opcode arg ...)
(with-syntax ((emit (id-append #'name #'emit- #'name)))
#'(define emit
- (let ((emit (emitter name opcode arg ...)))
- (hashq-set! emitters 'name emit)
+ (let ((emit (assembler name opcode arg ...)))
+ (hashq-set! assemblers 'name emit)
emit)))))))
(define-syntax visit-opcodes
@@ -361,8 +348,35 @@
(macro arg ... . inst)
...))))))
-(visit-opcodes define-emitter)
+(visit-opcodes define-assembler)
+
+(define-syntax define-macro-assembler
+ (lambda (x)
+ (syntax-case x ()
+ ((_ (name arg ...) body body* ...)
+ (with-syntax ((emit (id-append #'name #'emit- #'name)))
+ #'(define emit
+ (let ((emit (lambda (arg ...) body body* ...)))
+ (hashq-set! assemblers 'name emit)
+ emit)))))))
+(define-macro-assembler (load-constant asm dst obj)
+ (define (static? x)
+ (or (pair? x) (vector? x)))
+ (cond
+ ((immediate? obj)
+ (let ((bits (object-address obj)))
+ (cond
+ ((and (< dst 256) (zero? (ash bits -16)))
+ (emit-make-short-immediate asm dst obj))
+ ((zero? (ash bits -32))
+ (emit-make-long-immediate asm dst obj))
+ (else
+ (emit-make-long-long-immediate asm dst obj)))))
+ ((static? obj)
+ (emit-make-non-immediate asm dst (emit-non-immediate asm obj)))
+ (else
+ (emit-static-ref asm dst (emit-non-immediate asm obj)))))
(define-syntax disassembler
(lambda (x)
@@ -442,6 +456,9 @@
((L32)
;; FIXME: offset
#'(list word))
+ ((LO32)
+ ;; FIXME: offset
+ #'(list word))
((X8_U24)
#'(list (ash word -8)))
((X8_U12_U12)
@@ -519,10 +536,9 @@
(emit-label asm label)
(emit asm nlocals)
(emit asm 0)
- (finish-instruction asm)
(for-each (lambda (inst)
(if (pair? inst)
- (apply (or (hashq-ref emitters (car inst))
+ (apply (or (hashq-ref assemblers (car inst))
(error 'bad-instruction inst))
asm (cdr inst))
(emit-label asm inst)))
@@ -623,7 +639,7 @@
(cond
(rw-init
(set-uword! 8 DT_INIT) ; constants
- (set-label! 9 '.rtl-init)
+ (set-label! 9 rw-init)
(set-uword! 10 DT_NULL)
(set-uword! 11 0))
(else
@@ -667,13 +683,10 @@
((immediate? x)
(write-immediate asm buf pos x)
inits)
- ((vhash-assoc x (archive-constants (asm-archive asm)))
- => (lambda (ent)
- (write-immediate asm buf pos #f)
- ;; offset is in units of scm
- (cons `(init-scm ,label ,offset ,(cdr ent)) inits)))
(else
- (error "reference to unknown object" x))))
+ (write-immediate asm buf pos #f)
+ ;; offset is in units of scm
+ (cons `(init-non-immediate ,label ,offset ,x) inits))))
(define (write-stringbuf asm buf pos x label inits)
(let ((endianness (asm-endianness asm))
@@ -712,7 +725,6 @@
(let* ((word-size (asm-word-size asm))
(endianness (asm-endianness asm))
(archive (asm-archive asm))
- (stringbuf (cdr (vhash-assoc x (archive-stringbufs archive))))
(tag (logior tc7-ro-string (ash (string-length x) 8))))
(case word-size
((4)
@@ -726,7 +738,7 @@
(bytevector-u64-set! buf (+ pos 16) 0 endianness)
(bytevector-u64-set! buf (+ pos 24) (string-length x) endianness))
(else (error "bad word size")))
- (cons `(init-scm ,label 1 ,stringbuf) inits)))
+ (cons `(init-string ,label ,x) inits)))
(define (write-pair asm buf pos x label inits)
(let ((word-size (asm-word-size asm)))
@@ -753,31 +765,59 @@
(define (write-symbol asm buf pos x label inits)
(write-immediate asm buf pos #f)
- (cons `(string->symbol
- ,label
- ,(cdr (vhash-assoc (symbol->string x)
- (archive-constants (asm-archive asm)))))
- inits))
+ (cons `(init-symbol ,label ,x) inits))
(define (write-keyword asm buf pos x label inits)
(write-immediate asm buf pos #f)
- (cons `(symbol->keyword
- ,label
- ,(cdr (vhash-assoc (keyword->symbol x)
- (archive-constants (asm-archive asm)))))
- inits))
+ (cons `(init-keyword ,label ,x) inits))
(define (write-number asm buf pos x label inits)
(write-immediate asm buf pos #f)
- (cons `(string->number
- ,label
- ,(cdr (vhash-assoc (number->string x)
- (archive-constants (asm-archive asm)))))
- inits))
-
-(define (link-inits asm inits)
- ;; FIXME
- #f)
+ (cons `(init-number ,label ,x) inits))
+
+(define-macro-assembler (init-non-immediate asm label offset obj)
+ (let ((obj-label (cdr (vhash-assoc obj (archive-constants
+ (asm-archive asm))))))
+ (if (or (pair? obj) (vector? obj))
+ (emit-make-non-immediate asm 0 obj-label)
+ (emit-static-ref asm 0 obj-label))
+ (emit-static-set! asm 0 label offset)))
+
+(define-macro-assembler (init-string asm label obj)
+ (let ((obj-label (cdr (vhash-assoc obj
+ (archive-stringbufs (asm-archive asm))))))
+ (emit-make-non-immediate asm 0 obj-label)
+ (emit-static-set! asm 0 label 1)))
+
+(define-macro-assembler (init-symbol asm label obj)
+ (let ((str-label (cdr (vhash-assoc (symbol->string obj)
+ (archive-constants (asm-archive asm))))))
+ (emit-static-ref asm 0 str-label)
+ (emit-string->symbol asm 0 0)
+ (emit-static-set! asm 0 label 0)))
+
+(define-macro-assembler (init-keyword asm label obj)
+ (let ((sym-label (cdr (vhash-assoc (keyword->symbol obj)
+ (archive-constants (asm-archive asm))))))
+ (emit-static-ref asm 0 sym-label)
+ (emit-symbol->keyword asm 0 0)
+ (emit-static-set! asm 0 label 0)))
+
+(define-macro-assembler (init-number asm label obj)
+ (let ((str-label (cdr (vhash-assoc (number->string obj)
+ (archive-constants (asm-archive asm))))))
+ (emit-make-non-immediate asm 0 str-label)
+ (emit-string->number asm 0 0)
+ (emit-static-set! asm 0 label 0)))
+
+(define (emit-init-constants asm inits)
+ (let ((label (gensym "init-constants")))
+ (emit-program asm label 1
+ `((assert-nargs-ee/locals 0 1)
+ ,@inits
+ (load-constant 0 ,*unspecified*)
+ (return 0)))
+ label))
(define (link-data asm data strings-are-stringbufs?)
(define (statically-allocatable? x)
@@ -838,7 +878,7 @@
(error "unrecognized object" obj)))))
(values (make-object asm name buf '() labels)
(and (not (null? inits))
- (link-inits asm (reverse inits))))))))))
+ (emit-init-constants asm (reverse inits))))))))))
;; Hummm
;;
@@ -878,15 +918,17 @@
(lp (1+ i) ro (vhash-consq (car pair) (cdr pair) rw))))))))
(define (link-objects asm)
- (let ((text (link-text-object asm)))
- (call-with-values (lambda () (link-constants asm))
- (lambda (ro rw rw-init)
- (let* ((dt (link-dynamic-section asm text ro rw rw-init))
- ;; This needs to be linked last, because linking other
- ;; sections adds entries to the string table.
- (shstrtab (link-string-table asm)))
- (filter identity
- (list text ro rw rw-init dt shstrtab)))))))
+ (call-with-values (lambda () (link-constants asm))
+ (lambda (ro rw rw-init)
+ (let* (;; Link text object after constants, so that the constants
+ ;; initializer gets included.
+ (text (link-text-object asm))
+ (dt (link-dynamic-section asm text ro rw rw-init))
+ ;; This needs to be linked last, because linking other
+ ;; sections adds entries to the string table.
+ (shstrtab (link-string-table asm)))
+ (filter identity
+ (list text ro rw dt shstrtab))))))
(define (link-assembly asm)
(link-elf (link-objects asm)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-308-g63316ab,
Andy Wingo <=