| 1 | /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. |
| 2 | * |
| 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. |
| 7 | * |
| 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. |
| 12 | * |
| 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 |
| 16 | * 02110-1301 USA |
| 17 | */ |
| 18 | |
| 19 | #if HAVE_CONFIG_H |
| 20 | # include <config.h> |
| 21 | #endif |
| 22 | |
| 23 | #include <string.h> |
| 24 | |
| 25 | #include "_scm.h" |
| 26 | #include "threads.h" |
| 27 | #include "instructions.h" |
| 28 | |
| 29 | |
| 30 | SCM_SYMBOL (sym_left_arrow, "<-"); |
| 31 | SCM_SYMBOL (sym_bang, "!"); |
| 32 | |
| 33 | |
| 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) \ |
| 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) \ |
| 54 | M(X8_L24) \ |
| 55 | M(B1_X7_L24) \ |
| 56 | M(B1_U7_L24) \ |
| 57 | M(B1_X7_U24) \ |
| 58 | M(B1_X31) |
| 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 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 | (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. */ |
| 87 | |
| 88 | #define NOP SCM_T_UINT32_MAX |
| 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)) |
| 97 | #define OP5(type0, type1, type2, type3, type4) \ |
| 98 | (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4)) |
| 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 | |
| 105 | /* Scheme interface */ |
| 106 | |
| 107 | static SCM |
| 108 | parse_instruction (scm_t_uint8 opcode, const char *name, scm_t_uint32 meta) |
| 109 | { |
| 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) |
| 129 | { |
| 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; |
| 145 | } |
| 146 | } |
| 147 | |
| 148 | SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, |
| 149 | (void), |
| 150 | "") |
| 151 | #define FUNC_NAME s_scm_instruction_list |
| 152 | { |
| 153 | SCM list = SCM_EOL; |
| 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 |
| 159 | |
| 160 | return scm_reverse_x (list, SCM_EOL); |
| 161 | } |
| 162 | #undef FUNC_NAME |
| 163 | |
| 164 | void |
| 165 | scm_bootstrap_instructions (void) |
| 166 | { |
| 167 | scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, |
| 168 | "scm_init_instructions", |
| 169 | (scm_t_extension_init_func)scm_init_instructions, |
| 170 | NULL); |
| 171 | } |
| 172 | |
| 173 | void |
| 174 | scm_init_instructions (void) |
| 175 | { |
| 176 | #define INIT(type) \ |
| 177 | word_type_symbols[type] = scm_from_utf8_symbol (#type); |
| 178 | FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) |
| 179 | #undef INIT |
| 180 | |
| 181 | #ifndef SCM_MAGIC_SNARFER |
| 182 | #include "libguile/instructions.x" |
| 183 | #endif |
| 184 | } |
| 185 | |
| 186 | /* |
| 187 | Local Variables: |
| 188 | c-file-style: "gnu" |
| 189 | End: |
| 190 | */ |