Commit | Line | Data |
---|---|---|
510ca126 | 1 | /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. |
17e90c5e | 2 | * |
560b9c25 | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
17e90c5e | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
560b9c25 AW |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
17e90c5e | 12 | * |
560b9c25 AW |
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 | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
560b9c25 | 17 | */ |
17e90c5e | 18 | |
13c47753 AW |
19 | #if HAVE_CONFIG_H |
20 | # include <config.h> | |
21 | #endif | |
22 | ||
17e90c5e | 23 | #include <string.h> |
560b9c25 AW |
24 | |
25 | #include "_scm.h" | |
4b69f6ad | 26 | #include "threads.h" |
17e90c5e KN |
27 | #include "instructions.h" |
28 | ||
4b69f6ad | 29 | |
2a294c7c AW |
30 | SCM_SYMBOL (sym_left_arrow, "<-"); |
31 | SCM_SYMBOL (sym_bang, "!"); | |
32 | ||
33 | ||
510ca126 AW |
34 | #define OP_HAS_ARITY (1U << 0) |
35 | ||
36 | #define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \ | |
37 | M(X32) \ | |
38 | M(U8_X24) \ | |
39 | M(U8_U24) \ | |
40 | M(U8_L24) \ | |
510ca126 AW |
41 | M(U8_U8_I16) \ |
42 | M(U8_U8_U8_U8) \ | |
43 | M(U8_U12_U12) \ | |
44 | M(U32) /* Unsigned. */ \ | |
45 | M(I32) /* Immediate. */ \ | |
46 | M(A32) /* Immediate, high bits. */ \ | |
47 | M(B32) /* Immediate, low bits. */ \ | |
48 | M(N32) /* Non-immediate. */ \ | |
49 | M(S32) /* Scheme value (indirected). */ \ | |
50 | M(L32) /* Label. */ \ | |
51 | M(LO32) /* Label with offset. */ \ | |
52 | M(X8_U24) \ | |
53 | M(X8_U12_U12) \ | |
510ca126 AW |
54 | M(X8_L24) \ |
55 | M(B1_X7_L24) \ | |
af95414f AW |
56 | M(B1_U7_L24) \ |
57 | M(B1_X7_U24) \ | |
58 | M(B1_X31) | |
510ca126 AW |
59 | |
60 | #define TYPE_WIDTH 5 | |
61 | ||
62 | enum word_type | |
63 | { | |
64 | #define ENUM(type) type, | |
65 | FOR_EACH_INSTRUCTION_WORD_TYPE (ENUM) | |
66 | #undef ENUM | |
67 | }; | |
68 | ||
69 | static SCM word_type_symbols[] = | |
70 | { | |
71 | #define FALSE(type) SCM_BOOL_F, | |
72 | FOR_EACH_INSTRUCTION_WORD_TYPE (FALSE) | |
73 | #undef FALSE | |
74 | }; | |
75 | ||
76 | #define OP(n,type) ((type) << (n*TYPE_WIDTH)) | |
77 | ||
78 | /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of | |
79 | arguments each RTL instruction takes. This piece of code is the only | |
80 | bit that actually interprets that language. These macro definitions | |
81 | encode the operand types into bits in a 32-bit integer. | |
82 | ||
83 | (rtl-instruction-list) parses those encoded values into lists of | |
84 | symbols, one for each 32-bit word that the operator takes. (system | |
85 | vm rtl) uses those word types to generate assemblers and | |
86 | disassemblers for the instructions. */ | |
87 | ||
88 | #define OP1(type0) \ | |
89 | (OP (0, type0)) | |
90 | #define OP2(type0, type1) \ | |
91 | (OP (0, type0) | OP (1, type1)) | |
92 | #define OP3(type0, type1, type2) \ | |
93 | (OP (0, type0) | OP (1, type1) | OP (2, type2)) | |
94 | #define OP4(type0, type1, type2, type3) \ | |
95 | (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3)) | |
af95414f AW |
96 | #define OP5(type0, type1, type2, type3, type4) \ |
97 | (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4)) | |
510ca126 AW |
98 | |
99 | #define OP_DST (1 << (TYPE_WIDTH * 5)) | |
100 | ||
101 | #define WORD_TYPE(n, word) \ | |
102 | (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1)) | |
103 | ||
104 | struct scm_rtl_instruction { | |
105 | enum scm_rtl_opcode opcode; /* opcode */ | |
106 | const char *name; /* instruction name */ | |
107 | scm_t_uint32 meta; | |
108 | SCM symname; /* filled in later */ | |
109 | }; | |
110 | ||
111 | ||
53e28ed9 AW |
112 | #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \ |
113 | do { \ | |
114 | cvar = scm_lookup_instruction_by_name (var); \ | |
115 | SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P"); \ | |
116 | } while (0) | |
17e90c5e | 117 | |
53e28ed9 | 118 | |
4b69f6ad AW |
119 | static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; |
120 | ||
121 | ||
90a7976e | 122 | static const struct scm_rtl_instruction* |
510ca126 AW |
123 | fetch_rtl_instruction_table () |
124 | { | |
125 | static struct scm_rtl_instruction *table = NULL; | |
126 | ||
127 | scm_i_pthread_mutex_lock (&itable_lock); | |
128 | if (SCM_UNLIKELY (!table)) | |
129 | { | |
130 | size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_rtl_instruction); | |
131 | int i; | |
132 | table = malloc (bytes); | |
133 | memset (table, 0, bytes); | |
134 | ||
135 | #define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_; | |
136 | FOR_EACH_VM_OPERATION (INIT); | |
137 | #undef INIT | |
138 | ||
139 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) | |
140 | { | |
141 | table[i].opcode = i; | |
142 | if (table[i].name) | |
143 | table[i].symname = scm_from_utf8_symbol (table[i].name); | |
144 | else | |
145 | table[i].symname = SCM_BOOL_F; | |
146 | } | |
147 | } | |
148 | scm_i_pthread_mutex_unlock (&itable_lock); | |
149 | ||
150 | return table; | |
151 | } | |
152 | ||
53e28ed9 | 153 | |
17e90c5e KN |
154 | /* Scheme interface */ |
155 | ||
510ca126 AW |
156 | SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0, |
157 | (void), | |
158 | "") | |
159 | #define FUNC_NAME s_scm_rtl_instruction_list | |
160 | { | |
161 | SCM list = SCM_EOL; | |
162 | int i; | |
90a7976e | 163 | const struct scm_rtl_instruction *ip = fetch_rtl_instruction_table (); |
510ca126 AW |
164 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) |
165 | if (ip[i].name) | |
166 | { | |
167 | scm_t_uint32 meta = ip[i].meta; | |
168 | SCM tail = SCM_EOL; | |
169 | int len; | |
170 | ||
90a7976e | 171 | /* Format: (name opcode word0 word1 ...) */ |
510ca126 | 172 | |
af95414f AW |
173 | if (WORD_TYPE (4, meta)) |
174 | len = 5; | |
175 | else if (WORD_TYPE (3, meta)) | |
510ca126 AW |
176 | len = 4; |
177 | else if (WORD_TYPE (2, meta)) | |
178 | len = 3; | |
179 | else if (WORD_TYPE (1, meta)) | |
180 | len = 2; | |
181 | else if (WORD_TYPE (0, meta)) | |
182 | len = 1; | |
183 | else | |
184 | abort (); | |
185 | ||
186 | switch (len) | |
187 | { | |
af95414f AW |
188 | case 5: |
189 | tail = scm_cons (word_type_symbols[WORD_TYPE (4, meta)], tail); | |
510ca126 AW |
190 | case 4: |
191 | tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail); | |
192 | case 3: | |
193 | tail = scm_cons (word_type_symbols[WORD_TYPE (2, meta)], tail); | |
194 | case 2: | |
195 | tail = scm_cons (word_type_symbols[WORD_TYPE (1, meta)], tail); | |
196 | case 1: | |
197 | tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); | |
198 | default: | |
2a294c7c | 199 | tail = scm_cons ((meta & OP_DST) ? sym_left_arrow : sym_bang, tail); |
510ca126 AW |
200 | tail = scm_cons (scm_from_int (ip[i].opcode), tail); |
201 | tail = scm_cons (ip[i].symname, tail); | |
202 | break; | |
203 | } | |
204 | ||
205 | list = scm_cons (tail, list); | |
206 | } | |
207 | ||
208 | return scm_reverse_x (list, SCM_EOL); | |
209 | } | |
210 | #undef FUNC_NAME | |
211 | ||
07e56b27 AW |
212 | void |
213 | scm_bootstrap_instructions (void) | |
214 | { | |
44602b08 AW |
215 | scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, |
216 | "scm_init_instructions", | |
60ae5ca2 AW |
217 | (scm_t_extension_init_func)scm_init_instructions, |
218 | NULL); | |
510ca126 AW |
219 | |
220 | #define INIT(type) \ | |
221 | word_type_symbols[type] = scm_from_utf8_symbol (#type); | |
222 | FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) | |
223 | #undef INIT | |
07e56b27 AW |
224 | } |
225 | ||
17e90c5e KN |
226 | void |
227 | scm_init_instructions (void) | |
228 | { | |
229 | #ifndef SCM_MAGIC_SNARFER | |
aeeff258 | 230 | #include "libguile/instructions.x" |
17e90c5e KN |
231 | #endif |
232 | } | |
233 | ||
234 | /* | |
235 | Local Variables: | |
236 | c-file-style: "gnu" | |
237 | End: | |
238 | */ |