1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
27 #include "instructions.h"
30 struct scm_instruction
{
31 enum scm_opcode opcode
; /* opcode */
32 const char *name
; /* instruction name */
33 signed char len
; /* Instruction length. This may be -1 for
34 the loader (see the `VM_LOADER'
36 signed char npop
; /* The number of values popped. This may be
37 -1 for insns like `call' which can take
38 any number of arguments. */
39 char npush
; /* the number of values pushed */
40 SCM symname
; /* filled in later */
44 SCM_SYMBOL (sym_left_arrow
, "<-");
45 SCM_SYMBOL (sym_bang
, "!");
48 #define OP_HAS_ARITY (1U << 0)
50 #define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \
59 M(U32) /* Unsigned. */ \
60 M(I32) /* Immediate. */ \
61 M(A32) /* Immediate, high bits. */ \
62 M(B32) /* Immediate, low bits. */ \
63 M(N32) /* Non-immediate. */ \
64 M(S32) /* Scheme value (indirected). */ \
66 M(LO32) /* Label with offset. */ \
78 #define ENUM(type) type,
79 FOR_EACH_INSTRUCTION_WORD_TYPE (ENUM
)
83 static SCM word_type_symbols
[] =
85 #define FALSE(type) SCM_BOOL_F,
86 FOR_EACH_INSTRUCTION_WORD_TYPE (FALSE
)
90 #define OP(n,type) ((type) << (n*TYPE_WIDTH))
92 /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of
93 arguments each RTL instruction takes. This piece of code is the only
94 bit that actually interprets that language. These macro definitions
95 encode the operand types into bits in a 32-bit integer.
97 (rtl-instruction-list) parses those encoded values into lists of
98 symbols, one for each 32-bit word that the operator takes. (system
99 vm rtl) uses those word types to generate assemblers and
100 disassemblers for the instructions. */
104 #define OP2(type0, type1) \
105 (OP (0, type0) | OP (1, type1))
106 #define OP3(type0, type1, type2) \
107 (OP (0, type0) | OP (1, type1) | OP (2, type2))
108 #define OP4(type0, type1, type2, type3) \
109 (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3))
111 #define OP_DST (1 << (TYPE_WIDTH * 5))
113 #define WORD_TYPE(n, word) \
114 (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
116 struct scm_rtl_instruction
{
117 enum scm_rtl_opcode opcode
; /* opcode */
118 const char *name
; /* instruction name */
120 SCM symname
; /* filled in later */
124 #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \
126 cvar = scm_lookup_instruction_by_name (var); \
127 SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P"); \
131 static scm_i_pthread_mutex_t itable_lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
134 static const struct scm_instruction
*
135 fetch_instruction_table ()
137 static struct scm_instruction
*table
= NULL
;
139 scm_i_pthread_mutex_lock (&itable_lock
);
140 if (SCM_UNLIKELY (!table
))
142 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_instruction
);
144 table
= malloc (bytes
);
145 memset (table
, 0, bytes
);
146 #define VM_INSTRUCTION_TO_TABLE 1
147 #include <libguile/vm-expand.h>
148 #include <libguile/vm-i-system.i>
149 #include <libguile/vm-i-scheme.i>
150 #include <libguile/vm-i-loader.i>
151 #undef VM_INSTRUCTION_TO_TABLE
152 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
156 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
158 table
[i
].symname
= SCM_BOOL_F
;
161 scm_i_pthread_mutex_unlock (&itable_lock
);
166 static const struct scm_rtl_instruction
*
167 fetch_rtl_instruction_table ()
169 static struct scm_rtl_instruction
*table
= NULL
;
171 scm_i_pthread_mutex_lock (&itable_lock
);
172 if (SCM_UNLIKELY (!table
))
174 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_rtl_instruction
);
176 table
= malloc (bytes
);
177 memset (table
, 0, bytes
);
179 #define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_;
180 FOR_EACH_VM_OPERATION (INIT
);
183 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
187 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
189 table
[i
].symname
= SCM_BOOL_F
;
192 scm_i_pthread_mutex_unlock (&itable_lock
);
197 static const struct scm_instruction
*
198 scm_lookup_instruction_by_name (SCM name
)
200 static SCM instructions_by_name
= SCM_BOOL_F
;
201 const struct scm_instruction
*table
= fetch_instruction_table ();
204 if (SCM_UNLIKELY (scm_is_false (instructions_by_name
)))
208 instructions_by_name
=
209 scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS
));
211 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
212 if (scm_is_true (table
[i
].symname
))
213 scm_hashq_set_x (instructions_by_name
, table
[i
].symname
,
217 op
= scm_hashq_ref (instructions_by_name
, name
, SCM_UNDEFINED
);
218 if (SCM_I_INUMP (op
))
219 return &table
[SCM_I_INUM (op
)];
225 /* Scheme interface */
227 SCM_DEFINE (scm_instruction_list
, "instruction-list", 0, 0, 0,
230 #define FUNC_NAME s_scm_instruction_list
234 const struct scm_instruction
*ip
= fetch_instruction_table ();
235 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
237 list
= scm_cons (ip
[i
].symname
, list
);
238 return scm_reverse_x (list
, SCM_EOL
);
242 SCM_DEFINE (scm_rtl_instruction_list
, "rtl-instruction-list", 0, 0, 0,
245 #define FUNC_NAME s_scm_rtl_instruction_list
249 const struct scm_rtl_instruction
*ip
= fetch_rtl_instruction_table ();
250 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
253 scm_t_uint32 meta
= ip
[i
].meta
;
257 /* Format: (name opcode word0 word1 ...) */
259 if (WORD_TYPE (3, meta
))
261 else if (WORD_TYPE (2, meta
))
263 else if (WORD_TYPE (1, meta
))
265 else if (WORD_TYPE (0, meta
))
273 tail
= scm_cons (word_type_symbols
[WORD_TYPE (3, meta
)], tail
);
275 tail
= scm_cons (word_type_symbols
[WORD_TYPE (2, meta
)], tail
);
277 tail
= scm_cons (word_type_symbols
[WORD_TYPE (1, meta
)], tail
);
279 tail
= scm_cons (word_type_symbols
[WORD_TYPE (0, meta
)], tail
);
281 tail
= scm_cons ((meta
& OP_DST
) ? sym_left_arrow
: sym_bang
, tail
);
282 tail
= scm_cons (scm_from_int (ip
[i
].opcode
), tail
);
283 tail
= scm_cons (ip
[i
].symname
, tail
);
287 list
= scm_cons (tail
, list
);
290 return scm_reverse_x (list
, SCM_EOL
);
294 SCM_DEFINE (scm_instruction_p
, "instruction?", 1, 0, 0,
297 #define FUNC_NAME s_scm_instruction_p
299 return scm_from_bool (scm_lookup_instruction_by_name (obj
) != NULL
);
303 SCM_DEFINE (scm_instruction_length
, "instruction-length", 1, 0, 0,
306 #define FUNC_NAME s_scm_instruction_length
308 const struct scm_instruction
*ip
;
309 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
310 return SCM_I_MAKINUM (ip
->len
);
314 SCM_DEFINE (scm_instruction_pops
, "instruction-pops", 1, 0, 0,
317 #define FUNC_NAME s_scm_instruction_pops
319 const struct scm_instruction
*ip
;
320 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
321 return SCM_I_MAKINUM (ip
->npop
);
325 SCM_DEFINE (scm_instruction_pushes
, "instruction-pushes", 1, 0, 0,
328 #define FUNC_NAME s_scm_instruction_pushes
330 const struct scm_instruction
*ip
;
331 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
332 return SCM_I_MAKINUM (ip
->npush
);
336 SCM_DEFINE (scm_instruction_to_opcode
, "instruction->opcode", 1, 0, 0,
339 #define FUNC_NAME s_scm_instruction_to_opcode
341 const struct scm_instruction
*ip
;
342 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
343 return SCM_I_MAKINUM (ip
->opcode
);
347 SCM_DEFINE (scm_opcode_to_instruction
, "opcode->instruction", 1, 0, 0,
350 #define FUNC_NAME s_scm_opcode_to_instruction
352 scm_t_signed_bits opcode
;
353 SCM ret
= SCM_BOOL_F
;
355 SCM_MAKE_VALIDATE (1, op
, I_INUMP
);
356 opcode
= SCM_I_INUM (op
);
358 if (opcode
>= 0 && opcode
< SCM_VM_NUM_INSTRUCTIONS
)
359 ret
= fetch_instruction_table ()[opcode
].symname
;
361 if (scm_is_false (ret
))
362 scm_wrong_type_arg_msg (FUNC_NAME
, 1, op
, "INSTRUCTION_P");
369 scm_bootstrap_instructions (void)
371 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
372 "scm_init_instructions",
373 (scm_t_extension_init_func
)scm_init_instructions
,
377 word_type_symbols[type] = scm_from_utf8_symbol (#type);
378 FOR_EACH_INSTRUCTION_WORD_TYPE (INIT
)
383 scm_init_instructions (void)
385 #ifndef SCM_MAGIC_SNARFER
386 #include "libguile/instructions.x"