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 #define OP_HAS_ARITY (1U << 0)
46 #define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \
55 M(U32) /* Unsigned. */ \
56 M(I32) /* Immediate. */ \
57 M(A32) /* Immediate, high bits. */ \
58 M(B32) /* Immediate, low bits. */ \
59 M(N32) /* Non-immediate. */ \
60 M(S32) /* Scheme value (indirected). */ \
62 M(LO32) /* Label with offset. */ \
74 #define ENUM(type) type,
75 FOR_EACH_INSTRUCTION_WORD_TYPE (ENUM
)
79 static SCM word_type_symbols
[] =
81 #define FALSE(type) SCM_BOOL_F,
82 FOR_EACH_INSTRUCTION_WORD_TYPE (FALSE
)
86 #define OP(n,type) ((type) << (n*TYPE_WIDTH))
88 /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of
89 arguments each RTL instruction takes. This piece of code is the only
90 bit that actually interprets that language. These macro definitions
91 encode the operand types into bits in a 32-bit integer.
93 (rtl-instruction-list) parses those encoded values into lists of
94 symbols, one for each 32-bit word that the operator takes. (system
95 vm rtl) uses those word types to generate assemblers and
96 disassemblers for the instructions. */
100 #define OP2(type0, type1) \
101 (OP (0, type0) | OP (1, type1))
102 #define OP3(type0, type1, type2) \
103 (OP (0, type0) | OP (1, type1) | OP (2, type2))
104 #define OP4(type0, type1, type2, type3) \
105 (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3))
107 #define OP_DST (1 << (TYPE_WIDTH * 5))
109 #define WORD_TYPE(n, word) \
110 (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
112 struct scm_rtl_instruction
{
113 enum scm_rtl_opcode opcode
; /* opcode */
114 const char *name
; /* instruction name */
116 SCM symname
; /* filled in later */
120 #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \
122 cvar = scm_lookup_instruction_by_name (var); \
123 SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P"); \
127 static scm_i_pthread_mutex_t itable_lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
130 static const struct scm_instruction
*
131 fetch_instruction_table ()
133 static struct scm_instruction
*table
= NULL
;
135 scm_i_pthread_mutex_lock (&itable_lock
);
136 if (SCM_UNLIKELY (!table
))
138 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_instruction
);
140 table
= malloc (bytes
);
141 memset (table
, 0, bytes
);
142 #define VM_INSTRUCTION_TO_TABLE 1
143 #include <libguile/vm-expand.h>
144 #include <libguile/vm-i-system.i>
145 #include <libguile/vm-i-scheme.i>
146 #include <libguile/vm-i-loader.i>
147 #undef VM_INSTRUCTION_TO_TABLE
148 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
152 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
154 table
[i
].symname
= SCM_BOOL_F
;
157 scm_i_pthread_mutex_unlock (&itable_lock
);
162 static const struct scm_rtl_instruction
*
163 fetch_rtl_instruction_table ()
165 static struct scm_rtl_instruction
*table
= NULL
;
167 scm_i_pthread_mutex_lock (&itable_lock
);
168 if (SCM_UNLIKELY (!table
))
170 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_rtl_instruction
);
172 table
= malloc (bytes
);
173 memset (table
, 0, bytes
);
175 #define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_;
176 FOR_EACH_VM_OPERATION (INIT
);
179 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
183 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
185 table
[i
].symname
= SCM_BOOL_F
;
188 scm_i_pthread_mutex_unlock (&itable_lock
);
193 static const struct scm_instruction
*
194 scm_lookup_instruction_by_name (SCM name
)
196 static SCM instructions_by_name
= SCM_BOOL_F
;
197 const struct scm_instruction
*table
= fetch_instruction_table ();
200 if (SCM_UNLIKELY (scm_is_false (instructions_by_name
)))
204 instructions_by_name
=
205 scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS
));
207 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
208 if (scm_is_true (table
[i
].symname
))
209 scm_hashq_set_x (instructions_by_name
, table
[i
].symname
,
213 op
= scm_hashq_ref (instructions_by_name
, name
, SCM_UNDEFINED
);
214 if (SCM_I_INUMP (op
))
215 return &table
[SCM_I_INUM (op
)];
221 /* Scheme interface */
223 SCM_DEFINE (scm_instruction_list
, "instruction-list", 0, 0, 0,
226 #define FUNC_NAME s_scm_instruction_list
230 const struct scm_instruction
*ip
= fetch_instruction_table ();
231 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
233 list
= scm_cons (ip
[i
].symname
, list
);
234 return scm_reverse_x (list
, SCM_EOL
);
238 SCM_DEFINE (scm_rtl_instruction_list
, "rtl-instruction-list", 0, 0, 0,
241 #define FUNC_NAME s_scm_rtl_instruction_list
245 const struct scm_rtl_instruction
*ip
= fetch_rtl_instruction_table ();
246 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
249 scm_t_uint32 meta
= ip
[i
].meta
;
253 /* Format: (name opcode word0 word1 ...) */
255 if (WORD_TYPE (3, meta
))
257 else if (WORD_TYPE (2, meta
))
259 else if (WORD_TYPE (1, meta
))
261 else if (WORD_TYPE (0, meta
))
269 tail
= scm_cons (word_type_symbols
[WORD_TYPE (3, meta
)], tail
);
271 tail
= scm_cons (word_type_symbols
[WORD_TYPE (2, meta
)], tail
);
273 tail
= scm_cons (word_type_symbols
[WORD_TYPE (1, meta
)], tail
);
275 tail
= scm_cons (word_type_symbols
[WORD_TYPE (0, meta
)], tail
);
277 tail
= scm_cons (scm_from_int (ip
[i
].opcode
), tail
);
278 tail
= scm_cons (ip
[i
].symname
, tail
);
282 list
= scm_cons (tail
, list
);
285 return scm_reverse_x (list
, SCM_EOL
);
289 SCM_DEFINE (scm_instruction_p
, "instruction?", 1, 0, 0,
292 #define FUNC_NAME s_scm_instruction_p
294 return scm_from_bool (scm_lookup_instruction_by_name (obj
) != NULL
);
298 SCM_DEFINE (scm_instruction_length
, "instruction-length", 1, 0, 0,
301 #define FUNC_NAME s_scm_instruction_length
303 const struct scm_instruction
*ip
;
304 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
305 return SCM_I_MAKINUM (ip
->len
);
309 SCM_DEFINE (scm_instruction_pops
, "instruction-pops", 1, 0, 0,
312 #define FUNC_NAME s_scm_instruction_pops
314 const struct scm_instruction
*ip
;
315 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
316 return SCM_I_MAKINUM (ip
->npop
);
320 SCM_DEFINE (scm_instruction_pushes
, "instruction-pushes", 1, 0, 0,
323 #define FUNC_NAME s_scm_instruction_pushes
325 const struct scm_instruction
*ip
;
326 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
327 return SCM_I_MAKINUM (ip
->npush
);
331 SCM_DEFINE (scm_instruction_to_opcode
, "instruction->opcode", 1, 0, 0,
334 #define FUNC_NAME s_scm_instruction_to_opcode
336 const struct scm_instruction
*ip
;
337 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
338 return SCM_I_MAKINUM (ip
->opcode
);
342 SCM_DEFINE (scm_opcode_to_instruction
, "opcode->instruction", 1, 0, 0,
345 #define FUNC_NAME s_scm_opcode_to_instruction
347 scm_t_signed_bits opcode
;
348 SCM ret
= SCM_BOOL_F
;
350 SCM_MAKE_VALIDATE (1, op
, I_INUMP
);
351 opcode
= SCM_I_INUM (op
);
353 if (opcode
>= 0 && opcode
< SCM_VM_NUM_INSTRUCTIONS
)
354 ret
= fetch_instruction_table ()[opcode
].symname
;
356 if (scm_is_false (ret
))
357 scm_wrong_type_arg_msg (FUNC_NAME
, 1, op
, "INSTRUCTION_P");
364 scm_bootstrap_instructions (void)
366 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
367 "scm_init_instructions",
368 (scm_t_extension_init_func
)scm_init_instructions
,
372 word_type_symbols[type] = scm_from_utf8_symbol (#type);
373 FOR_EACH_INSTRUCTION_WORD_TYPE (INIT
)
378 scm_init_instructions (void)
380 #ifndef SCM_MAGIC_SNARFER
381 #include "libguile/instructions.x"