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 | |
1b780c13 | 79 | arguments each instruction takes. This piece of code is the only |
510ca126 AW |
80 | bit that actually interprets that language. These macro definitions |
81 | encode the operand types into bits in a 32-bit integer. | |
82 | ||
1b780c13 AW |
83 | (instruction-list) parses those encoded values into lists of symbols, |
84 | one for each 32-bit word that the operator takes. This list is used | |
85 | by Scheme to generate assemblers and disassemblers for the | |
86 | instructions. */ | |
510ca126 AW |
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 | ||
1b780c13 | 104 | struct scm_instruction { |
3fe96dd8 | 105 | enum scm_opcode opcode; /* opcode */ |
510ca126 AW |
106 | const char *name; /* instruction name */ |
107 | scm_t_uint32 meta; | |
108 | SCM symname; /* filled in later */ | |
109 | }; | |
110 | ||
111 | ||
4b69f6ad AW |
112 | static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; |
113 | ||
114 | ||
1b780c13 AW |
115 | static const struct scm_instruction* |
116 | fetch_instruction_table () | |
510ca126 | 117 | { |
1b780c13 | 118 | static struct scm_instruction *table = NULL; |
510ca126 AW |
119 | |
120 | scm_i_pthread_mutex_lock (&itable_lock); | |
121 | if (SCM_UNLIKELY (!table)) | |
122 | { | |
1b780c13 | 123 | size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction); |
510ca126 AW |
124 | int i; |
125 | table = malloc (bytes); | |
126 | memset (table, 0, bytes); | |
127 | ||
128 | #define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_; | |
129 | FOR_EACH_VM_OPERATION (INIT); | |
130 | #undef INIT | |
131 | ||
132 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) | |
133 | { | |
134 | table[i].opcode = i; | |
135 | if (table[i].name) | |
136 | table[i].symname = scm_from_utf8_symbol (table[i].name); | |
137 | else | |
138 | table[i].symname = SCM_BOOL_F; | |
139 | } | |
140 | } | |
141 | scm_i_pthread_mutex_unlock (&itable_lock); | |
142 | ||
143 | return table; | |
144 | } | |
145 | ||
53e28ed9 | 146 | |
17e90c5e KN |
147 | /* Scheme interface */ |
148 | ||
1b780c13 | 149 | SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, |
510ca126 AW |
150 | (void), |
151 | "") | |
1b780c13 | 152 | #define FUNC_NAME s_scm_instruction_list |
510ca126 AW |
153 | { |
154 | SCM list = SCM_EOL; | |
155 | int i; | |
1b780c13 | 156 | const struct scm_instruction *ip = fetch_instruction_table (); |
510ca126 AW |
157 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) |
158 | if (ip[i].name) | |
159 | { | |
160 | scm_t_uint32 meta = ip[i].meta; | |
161 | SCM tail = SCM_EOL; | |
162 | int len; | |
163 | ||
90a7976e | 164 | /* Format: (name opcode word0 word1 ...) */ |
510ca126 | 165 | |
af95414f AW |
166 | if (WORD_TYPE (4, meta)) |
167 | len = 5; | |
168 | else if (WORD_TYPE (3, meta)) | |
510ca126 AW |
169 | len = 4; |
170 | else if (WORD_TYPE (2, meta)) | |
171 | len = 3; | |
172 | else if (WORD_TYPE (1, meta)) | |
173 | len = 2; | |
174 | else if (WORD_TYPE (0, meta)) | |
175 | len = 1; | |
176 | else | |
177 | abort (); | |
178 | ||
179 | switch (len) | |
180 | { | |
af95414f AW |
181 | case 5: |
182 | tail = scm_cons (word_type_symbols[WORD_TYPE (4, meta)], tail); | |
510ca126 AW |
183 | case 4: |
184 | tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail); | |
185 | case 3: | |
186 | tail = scm_cons (word_type_symbols[WORD_TYPE (2, meta)], tail); | |
187 | case 2: | |
188 | tail = scm_cons (word_type_symbols[WORD_TYPE (1, meta)], tail); | |
189 | case 1: | |
190 | tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); | |
191 | default: | |
2a294c7c | 192 | tail = scm_cons ((meta & OP_DST) ? sym_left_arrow : sym_bang, tail); |
510ca126 AW |
193 | tail = scm_cons (scm_from_int (ip[i].opcode), tail); |
194 | tail = scm_cons (ip[i].symname, tail); | |
195 | break; | |
196 | } | |
197 | ||
198 | list = scm_cons (tail, list); | |
199 | } | |
200 | ||
201 | return scm_reverse_x (list, SCM_EOL); | |
202 | } | |
203 | #undef FUNC_NAME | |
204 | ||
07e56b27 AW |
205 | void |
206 | scm_bootstrap_instructions (void) | |
207 | { | |
44602b08 AW |
208 | scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, |
209 | "scm_init_instructions", | |
60ae5ca2 AW |
210 | (scm_t_extension_init_func)scm_init_instructions, |
211 | NULL); | |
1b780c13 | 212 | } |
510ca126 | 213 | |
1b780c13 AW |
214 | void |
215 | scm_init_instructions (void) | |
216 | { | |
510ca126 AW |
217 | #define INIT(type) \ |
218 | word_type_symbols[type] = scm_from_utf8_symbol (#type); | |
219 | FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) | |
220 | #undef INIT | |
07e56b27 | 221 | |
17e90c5e | 222 | #ifndef SCM_MAGIC_SNARFER |
aeeff258 | 223 | #include "libguile/instructions.x" |
17e90c5e KN |
224 | #endif |
225 | } | |
226 | ||
227 | /* | |
228 | Local Variables: | |
229 | c-file-style: "gnu" | |
230 | End: | |
231 | */ |