libguile/instructions.c

   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 */