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 | 87 | |
d86682ba | 88 | #define NOP SCM_T_UINT32_MAX |
510ca126 AW |
89 | #define OP1(type0) \ |
90 | (OP (0, type0)) | |
91 | #define OP2(type0, type1) \ | |
92 | (OP (0, type0) | OP (1, type1)) | |
93 | #define OP3(type0, type1, type2) \ | |
94 | (OP (0, type0) | OP (1, type1) | OP (2, type2)) | |
95 | #define OP4(type0, type1, type2, type3) \ | |
96 | (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3)) | |
af95414f AW |
97 | #define OP5(type0, type1, type2, type3, type4) \ |
98 | (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4)) | |
510ca126 AW |
99 | |
100 | #define OP_DST (1 << (TYPE_WIDTH * 5)) | |
101 | ||
102 | #define WORD_TYPE(n, word) \ | |
103 | (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1)) | |
104 | ||
d86682ba | 105 | /* Scheme interface */ |
4b69f6ad | 106 | |
d86682ba AW |
107 | static SCM |
108 | parse_instruction (scm_t_uint8 opcode, const char *name, scm_t_uint32 meta) | |
510ca126 | 109 | { |
d86682ba AW |
110 | SCM tail = SCM_EOL; |
111 | int len; | |
112 | ||
113 | /* Format: (name opcode word0 word1 ...) */ | |
114 | ||
115 | if (WORD_TYPE (4, meta)) | |
116 | len = 5; | |
117 | else if (WORD_TYPE (3, meta)) | |
118 | len = 4; | |
119 | else if (WORD_TYPE (2, meta)) | |
120 | len = 3; | |
121 | else if (WORD_TYPE (1, meta)) | |
122 | len = 2; | |
123 | else if (WORD_TYPE (0, meta)) | |
124 | len = 1; | |
125 | else | |
126 | abort (); | |
127 | ||
128 | switch (len) | |
510ca126 | 129 | { |
d86682ba AW |
130 | case 5: |
131 | tail = scm_cons (word_type_symbols[WORD_TYPE (4, meta)], tail); | |
132 | case 4: | |
133 | tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail); | |
134 | case 3: | |
135 | tail = scm_cons (word_type_symbols[WORD_TYPE (2, meta)], tail); | |
136 | case 2: | |
137 | tail = scm_cons (word_type_symbols[WORD_TYPE (1, meta)], tail); | |
138 | case 1: | |
139 | tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); | |
140 | default: | |
141 | tail = scm_cons ((meta & OP_DST) ? sym_left_arrow : sym_bang, tail); | |
142 | tail = scm_cons (scm_from_int (opcode), tail); | |
143 | tail = scm_cons (scm_from_utf8_symbol (name), tail); | |
144 | return tail; | |
510ca126 | 145 | } |
510ca126 AW |
146 | } |
147 | ||
1b780c13 | 148 | SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, |
510ca126 AW |
149 | (void), |
150 | "") | |
1b780c13 | 151 | #define FUNC_NAME s_scm_instruction_list |
510ca126 AW |
152 | { |
153 | SCM list = SCM_EOL; | |
d86682ba AW |
154 | |
155 | #define INIT(opcode, tag, name, meta) \ | |
156 | if (name) list = scm_cons (parse_instruction (opcode, name, meta), list); | |
157 | FOR_EACH_VM_OPERATION (INIT); | |
158 | #undef INIT | |
510ca126 AW |
159 | |
160 | return scm_reverse_x (list, SCM_EOL); | |
161 | } | |
162 | #undef FUNC_NAME | |
163 | ||
07e56b27 AW |
164 | void |
165 | scm_bootstrap_instructions (void) | |
166 | { | |
44602b08 AW |
167 | scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, |
168 | "scm_init_instructions", | |
60ae5ca2 AW |
169 | (scm_t_extension_init_func)scm_init_instructions, |
170 | NULL); | |
1b780c13 | 171 | } |
510ca126 | 172 | |
1b780c13 AW |
173 | void |
174 | scm_init_instructions (void) | |
175 | { | |
510ca126 AW |
176 | #define INIT(type) \ |
177 | word_type_symbols[type] = scm_from_utf8_symbol (#type); | |
178 | FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) | |
179 | #undef INIT | |
07e56b27 | 180 | |
17e90c5e | 181 | #ifndef SCM_MAGIC_SNARFER |
aeeff258 | 182 | #include "libguile/instructions.x" |
17e90c5e KN |
183 | #endif |
184 | } | |
185 | ||
186 | /* | |
187 | Local Variables: | |
188 | c-file-style: "gnu" | |
189 | End: | |
190 | */ |