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) \
58 M(U32) /* Unsigned. */ \
59 M(I32) /* Immediate. */ \
60 M(A32) /* Immediate, high bits. */ \
61 M(B32) /* Immediate, low bits. */ \
62 M(N32) /* Non-immediate. */ \
63 M(S32) /* Scheme value (indirected). */ \
65 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))
110 #define OP5(type0, type1, type2, type3, type4) \
111 (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4))
113 #define OP_DST (1 << (TYPE_WIDTH * 5))
115 #define WORD_TYPE(n, word) \
116 (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
118 struct scm_rtl_instruction
{
119 enum scm_rtl_opcode opcode
; /* opcode */
120 const char *name
; /* instruction name */
122 SCM symname
; /* filled in later */
126 #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \
128 cvar = scm_lookup_instruction_by_name (var); \
129 SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P"); \
133 static scm_i_pthread_mutex_t itable_lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
136 static const struct scm_instruction
*
137 fetch_instruction_table ()
139 static struct scm_instruction
*table
= NULL
;
141 scm_i_pthread_mutex_lock (&itable_lock
);
142 if (SCM_UNLIKELY (!table
))
144 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_instruction
);
146 table
= malloc (bytes
);
147 memset (table
, 0, bytes
);
148 #define VM_INSTRUCTION_TO_TABLE 1
149 #include <libguile/vm-expand.h>
150 #include <libguile/vm-i-system.i>
151 #include <libguile/vm-i-scheme.i>
152 #include <libguile/vm-i-loader.i>
153 #undef VM_INSTRUCTION_TO_TABLE
154 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
158 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
160 table
[i
].symname
= SCM_BOOL_F
;
163 scm_i_pthread_mutex_unlock (&itable_lock
);
168 static const struct scm_rtl_instruction
*
169 fetch_rtl_instruction_table ()
171 static struct scm_rtl_instruction
*table
= NULL
;
173 scm_i_pthread_mutex_lock (&itable_lock
);
174 if (SCM_UNLIKELY (!table
))
176 size_t bytes
= SCM_VM_NUM_INSTRUCTIONS
* sizeof(struct scm_rtl_instruction
);
178 table
= malloc (bytes
);
179 memset (table
, 0, bytes
);
181 #define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_;
182 FOR_EACH_VM_OPERATION (INIT
);
185 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
189 table
[i
].symname
= scm_from_utf8_symbol (table
[i
].name
);
191 table
[i
].symname
= SCM_BOOL_F
;
194 scm_i_pthread_mutex_unlock (&itable_lock
);
199 static const struct scm_instruction
*
200 scm_lookup_instruction_by_name (SCM name
)
202 static SCM instructions_by_name
= SCM_BOOL_F
;
203 const struct scm_instruction
*table
= fetch_instruction_table ();
206 if (SCM_UNLIKELY (scm_is_false (instructions_by_name
)))
210 instructions_by_name
=
211 scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS
));
213 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
214 if (scm_is_true (table
[i
].symname
))
215 scm_hashq_set_x (instructions_by_name
, table
[i
].symname
,
219 op
= scm_hashq_ref (instructions_by_name
, name
, SCM_UNDEFINED
);
220 if (SCM_I_INUMP (op
))
221 return &table
[SCM_I_INUM (op
)];
227 /* Scheme interface */
229 SCM_DEFINE (scm_instruction_list
, "instruction-list", 0, 0, 0,
232 #define FUNC_NAME s_scm_instruction_list
236 const struct scm_instruction
*ip
= fetch_instruction_table ();
237 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
239 list
= scm_cons (ip
[i
].symname
, list
);
240 return scm_reverse_x (list
, SCM_EOL
);
244 SCM_DEFINE (scm_rtl_instruction_list
, "rtl-instruction-list", 0, 0, 0,
247 #define FUNC_NAME s_scm_rtl_instruction_list
251 const struct scm_rtl_instruction
*ip
= fetch_rtl_instruction_table ();
252 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
255 scm_t_uint32 meta
= ip
[i
].meta
;
259 /* Format: (name opcode word0 word1 ...) */
261 if (WORD_TYPE (4, meta
))
263 else if (WORD_TYPE (3, meta
))
265 else if (WORD_TYPE (2, meta
))
267 else if (WORD_TYPE (1, meta
))
269 else if (WORD_TYPE (0, meta
))
277 tail
= scm_cons (word_type_symbols
[WORD_TYPE (4, meta
)], tail
);
279 tail
= scm_cons (word_type_symbols
[WORD_TYPE (3, meta
)], tail
);
281 tail
= scm_cons (word_type_symbols
[WORD_TYPE (2, meta
)], tail
);
283 tail
= scm_cons (word_type_symbols
[WORD_TYPE (1, meta
)], tail
);
285 tail
= scm_cons (word_type_symbols
[WORD_TYPE (0, meta
)], tail
);
287 tail
= scm_cons ((meta
& OP_DST
) ? sym_left_arrow
: sym_bang
, tail
);
288 tail
= scm_cons (scm_from_int (ip
[i
].opcode
), tail
);
289 tail
= scm_cons (ip
[i
].symname
, tail
);
293 list
= scm_cons (tail
, list
);
296 return scm_reverse_x (list
, SCM_EOL
);
300 SCM_DEFINE (scm_instruction_p
, "instruction?", 1, 0, 0,
303 #define FUNC_NAME s_scm_instruction_p
305 return scm_from_bool (scm_lookup_instruction_by_name (obj
) != NULL
);
309 SCM_DEFINE (scm_instruction_length
, "instruction-length", 1, 0, 0,
312 #define FUNC_NAME s_scm_instruction_length
314 const struct scm_instruction
*ip
;
315 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
316 return SCM_I_MAKINUM (ip
->len
);
320 SCM_DEFINE (scm_instruction_pops
, "instruction-pops", 1, 0, 0,
323 #define FUNC_NAME s_scm_instruction_pops
325 const struct scm_instruction
*ip
;
326 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
327 return SCM_I_MAKINUM (ip
->npop
);
331 SCM_DEFINE (scm_instruction_pushes
, "instruction-pushes", 1, 0, 0,
334 #define FUNC_NAME s_scm_instruction_pushes
336 const struct scm_instruction
*ip
;
337 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
338 return SCM_I_MAKINUM (ip
->npush
);
342 SCM_DEFINE (scm_instruction_to_opcode
, "instruction->opcode", 1, 0, 0,
345 #define FUNC_NAME s_scm_instruction_to_opcode
347 const struct scm_instruction
*ip
;
348 SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst
, ip
);
349 return SCM_I_MAKINUM (ip
->opcode
);
353 SCM_DEFINE (scm_opcode_to_instruction
, "opcode->instruction", 1, 0, 0,
356 #define FUNC_NAME s_scm_opcode_to_instruction
358 scm_t_signed_bits opcode
;
359 SCM ret
= SCM_BOOL_F
;
361 SCM_MAKE_VALIDATE (1, op
, I_INUMP
);
362 opcode
= SCM_I_INUM (op
);
364 if (opcode
>= 0 && opcode
< SCM_VM_NUM_INSTRUCTIONS
)
365 ret
= fetch_instruction_table ()[opcode
].symname
;
367 if (scm_is_false (ret
))
368 scm_wrong_type_arg_msg (FUNC_NAME
, 1, op
, "INSTRUCTION_P");
375 scm_bootstrap_instructions (void)
377 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
378 "scm_init_instructions",
379 (scm_t_extension_init_func
)scm_init_instructions
,
383 word_type_symbols[type] = scm_from_utf8_symbol (#type);
384 FOR_EACH_INSTRUCTION_WORD_TYPE (INIT
)
389 scm_init_instructions (void)
391 #ifndef SCM_MAGIC_SNARFER
392 #include "libguile/instructions.x"