libguile/instructions.c

   1 /* Copyright (C) 2001, 2009 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 "vm-bootstrap.h"
  27 #include "instructions.h"
  28
  29 struct scm_instruction {
  30   enum scm_opcode opcode;       /* opcode */
  31   const char *name;             /* instruction name */
  32   signed char len;              /* Instruction length.  This may be -1 for
  33                                    the loader (see the `VM_LOADER'
  34                                    macro).  */
  35   signed char npop;             /* The number of values popped.  This may be
  36                                    -1 for insns like `call' which can take
  37                                    any number of arguments.  */
  38   char npush;                   /* the number of values pushed */
  39   SCM symname;                  /* filled in later */
  40 };
  41
  42 #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar)               \
  43   do {                                                                \
  44     cvar = scm_lookup_instruction_by_name (var);                      \
  45     SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P");     \
  46   } while (0)
  47
  48
  49 static struct scm_instruction*
  50 fetch_instruction_table ()
  51 {
  52   static struct scm_instruction *table = NULL;
  53
  54   if (SCM_UNLIKELY (!table))
  55     {
  56       size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction);
  57       int i;
  58       table = malloc (bytes);
  59       memset (table, 0, bytes);
  60 #define VM_INSTRUCTION_TO_TABLE 1
  61 #include <libguile/vm-expand.h>
  62 #include <libguile/vm-i-system.i>
  63 #include <libguile/vm-i-scheme.i>
  64 #include <libguile/vm-i-loader.i>
  65 #undef VM_INSTRUCTION_TO_TABLE
  66       for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
  67         {
  68           table[i].opcode = i;
  69           if (table[i].name)
  70             table[i].symname =
  71               scm_permanent_object (scm_from_locale_symbol (table[i].name));
  72           else
  73             table[i].symname = SCM_BOOL_F;
  74         }
  75     }
  76   return table;
  77 }
  78
  79 static struct scm_instruction *
  80 scm_lookup_instruction_by_name (SCM name)
  81 {
  82   static SCM instructions_by_name = SCM_BOOL_F;
  83   struct scm_instruction *table = fetch_instruction_table ();
  84   SCM op;
  85
  86   if (SCM_UNLIKELY (SCM_FALSEP (instructions_by_name)))
  87     {
  88       int i;
  89       instructions_by_name = scm_permanent_object
  90         (scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS)));
  91       for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
  92         if (scm_is_true (table[i].symname))
  93           scm_hashq_set_x (instructions_by_name, table[i].symname,
  94                            SCM_I_MAKINUM (i));
  95     }
  96
  97   op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED);
  98   if (SCM_I_INUMP (op))
  99     return &table[SCM_I_INUM (op)];
 100
 101   return NULL;
 102 }
 103
 104
 105 /* Scheme interface */
 106
 107 SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
 108             (void),
 109             "")
 110 #define FUNC_NAME s_scm_instruction_list
 111 {
 112   SCM list = SCM_EOL;
 113   int i;
 114   struct scm_instruction *ip = fetch_instruction_table ();
 115   for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
 116     if (ip[i].name)
 117       list = scm_cons (ip[i].symname, list);
 118   return scm_reverse_x (list, SCM_EOL);
 119 }
 120 #undef FUNC_NAME
 121
 122 SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0,
 123             (SCM obj),
 124             "")
 125 #define FUNC_NAME s_scm_instruction_p
 126 {
 127   return SCM_BOOL (scm_lookup_instruction_by_name (obj));
 128 }
 129 #undef FUNC_NAME
 130
 131 SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
 132             (SCM inst),
 133             "")
 134 #define FUNC_NAME s_scm_instruction_length
 135 {
 136   struct scm_instruction *ip;
 137   SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
 138   return SCM_I_MAKINUM (ip->len);
 139 }
 140 #undef FUNC_NAME
 141
 142 SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
 143             (SCM inst),
 144             "")
 145 #define FUNC_NAME s_scm_instruction_pops
 146 {
 147   struct scm_instruction *ip;
 148   SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
 149   return SCM_I_MAKINUM (ip->npop);
 150 }
 151 #undef FUNC_NAME
 152
 153 SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
 154             (SCM inst),
 155             "")
 156 #define FUNC_NAME s_scm_instruction_pushes
 157 {
 158   struct scm_instruction *ip;
 159   SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
 160   return SCM_I_MAKINUM (ip->npush);
 161 }
 162 #undef FUNC_NAME
 163
 164 SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
 165             (SCM inst),
 166             "")
 167 #define FUNC_NAME s_scm_instruction_to_opcode
 168 {
 169   struct scm_instruction *ip;
 170   SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
 171   return SCM_I_MAKINUM (ip->opcode);
 172 }
 173 #undef FUNC_NAME
 174
 175 SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
 176             (SCM op),
 177             "")
 178 #define FUNC_NAME s_scm_opcode_to_instruction
 179 {
 180   int opcode;
 181   SCM ret = SCM_BOOL_F;
 182
 183   SCM_MAKE_VALIDATE (1, op, I_INUMP);
 184   opcode = SCM_I_INUM (op);
 185
 186   if (opcode >= 0 && opcode < SCM_VM_NUM_INSTRUCTIONS)
 187     ret = fetch_instruction_table ()[opcode].symname;
 188
 189   if (scm_is_false (ret))
 190     scm_wrong_type_arg_msg (FUNC_NAME, 1, op, "INSTRUCTION_P");
 191
 192   return ret;
 193 }
 194 #undef FUNC_NAME
 195
 196 void
 197 scm_bootstrap_instructions (void)
 198 {
 199   scm_c_register_extension ("libguile", "scm_init_instructions",
 200                             (scm_t_extension_init_func)scm_init_instructions,
 201                             NULL);
 202 }
 203
 204 void
 205 scm_init_instructions (void)
 206 {
 207   scm_bootstrap_vm ();
 208
 209 #ifndef SCM_MAGIC_SNARFER
 210 #include "libguile/instructions.x"
 211 #endif
 212 }
 213
 214 /*
 215   Local Variables:
 216   c-file-style: "gnu"
 217   End:
 218 */