diff options
Diffstat (limited to 'libguile/instructions.c')
-rw-r--r-- | libguile/instructions.c | 195 |
1 files changed, 185 insertions, 10 deletions
diff --git a/libguile/instructions.c b/libguile/instructions.c index ef4a9ce17..43937d76a 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -40,6 +40,89 @@ struct scm_instruction { SCM symname; /* filled in later */ }; + +SCM_SYMBOL (sym_left_arrow, "<-"); +SCM_SYMBOL (sym_bang, "!"); + + +#define OP_HAS_ARITY (1U << 0) + +#define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \ + M(X32) \ + M(U8_X24) \ + M(U8_U24) \ + M(U8_L24) \ + M(U8_U8_I16) \ + M(U8_U8_U8_U8) \ + M(U8_U12_U12) \ + M(U32) /* Unsigned. */ \ + M(I32) /* Immediate. */ \ + M(A32) /* Immediate, high bits. */ \ + M(B32) /* Immediate, low bits. */ \ + M(N32) /* Non-immediate. */ \ + M(S32) /* Scheme value (indirected). */ \ + M(L32) /* Label. */ \ + M(LO32) /* Label with offset. */ \ + M(X8_U24) \ + M(X8_U12_U12) \ + M(X8_L24) \ + M(B1_X7_L24) \ + M(B1_U7_L24) \ + M(B1_X7_U24) \ + M(B1_X31) + +#define TYPE_WIDTH 5 + +enum word_type + { +#define ENUM(type) type, + FOR_EACH_INSTRUCTION_WORD_TYPE (ENUM) +#undef ENUM + }; + +static SCM word_type_symbols[] = + { +#define FALSE(type) SCM_BOOL_F, + FOR_EACH_INSTRUCTION_WORD_TYPE (FALSE) +#undef FALSE + }; + +#define OP(n,type) ((type) << (n*TYPE_WIDTH)) + +/* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of + arguments each RTL instruction takes. This piece of code is the only + bit that actually interprets that language. These macro definitions + encode the operand types into bits in a 32-bit integer. + + (rtl-instruction-list) parses those encoded values into lists of + symbols, one for each 32-bit word that the operator takes. (system + vm rtl) uses those word types to generate assemblers and + disassemblers for the instructions. */ + +#define OP1(type0) \ + (OP (0, type0)) +#define OP2(type0, type1) \ + (OP (0, type0) | OP (1, type1)) +#define OP3(type0, type1, type2) \ + (OP (0, type0) | OP (1, type1) | OP (2, type2)) +#define OP4(type0, type1, type2, type3) \ + (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3)) +#define OP5(type0, type1, type2, type3, type4) \ + (OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4)) + +#define OP_DST (1 << (TYPE_WIDTH * 5)) + +#define WORD_TYPE(n, word) \ + (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1)) + +struct scm_rtl_instruction { + enum scm_rtl_opcode opcode; /* opcode */ + const char *name; /* instruction name */ + scm_t_uint32 meta; + SCM symname; /* filled in later */ +}; + + #define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \ do { \ cvar = scm_lookup_instruction_by_name (var); \ @@ -50,7 +133,7 @@ struct scm_instruction { static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; -static struct scm_instruction* +static const struct scm_instruction* fetch_instruction_table () { static struct scm_instruction *table = NULL; @@ -72,7 +155,38 @@ fetch_instruction_table () { table[i].opcode = i; if (table[i].name) - table[i].symname = scm_from_locale_symbol (table[i].name); + table[i].symname = scm_from_utf8_symbol (table[i].name); + else + table[i].symname = SCM_BOOL_F; + } + } + scm_i_pthread_mutex_unlock (&itable_lock); + + return table; +} + +static const struct scm_rtl_instruction* +fetch_rtl_instruction_table () +{ + static struct scm_rtl_instruction *table = NULL; + + scm_i_pthread_mutex_lock (&itable_lock); + if (SCM_UNLIKELY (!table)) + { + size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_rtl_instruction); + int i; + table = malloc (bytes); + memset (table, 0, bytes); + +#define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_; + FOR_EACH_VM_OPERATION (INIT); +#undef INIT + + for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) + { + table[i].opcode = i; + if (table[i].name) + table[i].symname = scm_from_utf8_symbol (table[i].name); else table[i].symname = SCM_BOOL_F; } @@ -82,11 +196,11 @@ fetch_instruction_table () return table; } -static struct scm_instruction * +static const struct scm_instruction * scm_lookup_instruction_by_name (SCM name) { static SCM instructions_by_name = SCM_BOOL_F; - struct scm_instruction *table = fetch_instruction_table (); + const struct scm_instruction *table = fetch_instruction_table (); SCM op; if (SCM_UNLIKELY (scm_is_false (instructions_by_name))) @@ -119,7 +233,7 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, { SCM list = SCM_EOL; int i; - struct scm_instruction *ip = fetch_instruction_table (); + const struct scm_instruction *ip = fetch_instruction_table (); for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) if (ip[i].name) list = scm_cons (ip[i].symname, list); @@ -127,6 +241,62 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0, + (void), + "") +#define FUNC_NAME s_scm_rtl_instruction_list +{ + SCM list = SCM_EOL; + int i; + const struct scm_rtl_instruction *ip = fetch_rtl_instruction_table (); + for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) + if (ip[i].name) + { + scm_t_uint32 meta = ip[i].meta; + SCM tail = SCM_EOL; + int len; + + /* Format: (name opcode word0 word1 ...) */ + + if (WORD_TYPE (4, meta)) + len = 5; + else if (WORD_TYPE (3, meta)) + len = 4; + else if (WORD_TYPE (2, meta)) + len = 3; + else if (WORD_TYPE (1, meta)) + len = 2; + else if (WORD_TYPE (0, meta)) + len = 1; + else + abort (); + + switch (len) + { + case 5: + tail = scm_cons (word_type_symbols[WORD_TYPE (4, meta)], tail); + case 4: + tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail); + case 3: + tail = scm_cons (word_type_symbols[WORD_TYPE (2, meta)], tail); + case 2: + tail = scm_cons (word_type_symbols[WORD_TYPE (1, meta)], tail); + case 1: + tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); + default: + tail = scm_cons ((meta & OP_DST) ? sym_left_arrow : sym_bang, tail); + tail = scm_cons (scm_from_int (ip[i].opcode), tail); + tail = scm_cons (ip[i].symname, tail); + break; + } + + list = scm_cons (tail, list); + } + + return scm_reverse_x (list, SCM_EOL); +} +#undef FUNC_NAME + SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0, (SCM obj), "") @@ -141,7 +311,7 @@ SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0, "") #define FUNC_NAME s_scm_instruction_length { - struct scm_instruction *ip; + const struct scm_instruction *ip; SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip); return SCM_I_MAKINUM (ip->len); } @@ -152,7 +322,7 @@ SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0, "") #define FUNC_NAME s_scm_instruction_pops { - struct scm_instruction *ip; + const struct scm_instruction *ip; SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip); return SCM_I_MAKINUM (ip->npop); } @@ -163,7 +333,7 @@ SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0, "") #define FUNC_NAME s_scm_instruction_pushes { - struct scm_instruction *ip; + const struct scm_instruction *ip; SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip); return SCM_I_MAKINUM (ip->npush); } @@ -174,7 +344,7 @@ SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0, "") #define FUNC_NAME s_scm_instruction_to_opcode { - struct scm_instruction *ip; + const struct scm_instruction *ip; SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip); return SCM_I_MAKINUM (ip->opcode); } @@ -208,6 +378,11 @@ scm_bootstrap_instructions (void) "scm_init_instructions", (scm_t_extension_init_func)scm_init_instructions, NULL); + +#define INIT(type) \ + word_type_symbols[type] = scm_from_utf8_symbol (#type); + FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) +#undef INIT } void |