X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/60ae5ca2a31a89b8930089f7dbfa3a99ac727383..9f17d967c9b108f856776c035462e93017a6e7e2:/libguile/instructions.c diff --git a/libguile/instructions.c b/libguile/instructions.c index 4f504f0a2..ef4a9ce17 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -1,52 +1,32 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. +/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ #if HAVE_CONFIG_H # include #endif #include -#include "vm-bootstrap.h" + +#include "_scm.h" +#include "threads.h" #include "instructions.h" + struct scm_instruction { enum scm_opcode opcode; /* opcode */ const char *name; /* instruction name */ @@ -67,14 +47,18 @@ struct scm_instruction { } while (0) +static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; + + static struct scm_instruction* fetch_instruction_table () { static struct scm_instruction *table = NULL; + scm_i_pthread_mutex_lock (&itable_lock); if (SCM_UNLIKELY (!table)) { - size_t bytes = scm_op_last * sizeof(struct scm_instruction); + size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction); int i; table = malloc (bytes); memset (table, 0, bytes); @@ -84,7 +68,7 @@ fetch_instruction_table () #include #include #undef VM_INSTRUCTION_TO_TABLE - for (i = 0; i < scm_op_last; i++) + for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) { table[i].opcode = i; if (table[i].name) @@ -93,6 +77,8 @@ fetch_instruction_table () table[i].symname = SCM_BOOL_F; } } + scm_i_pthread_mutex_unlock (&itable_lock); + return table; } @@ -103,17 +89,19 @@ scm_lookup_instruction_by_name (SCM name) struct scm_instruction *table = fetch_instruction_table (); SCM op; - if (SCM_UNLIKELY (SCM_FALSEP (instructions_by_name))) - { - int i; - instructions_by_name = scm_make_hash_table (SCM_I_MAKINUM (scm_op_last)); - for (i = 0; i < scm_op_last; i++) + if (SCM_UNLIKELY (scm_is_false (instructions_by_name))) + { + unsigned int i; + + instructions_by_name = + scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS)); + + for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) if (scm_is_true (table[i].symname)) scm_hashq_set_x (instructions_by_name, table[i].symname, SCM_I_MAKINUM (i)); - instructions_by_name = scm_permanent_object (instructions_by_name); } - + op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED); if (SCM_I_INUMP (op)) return &table[SCM_I_INUM (op)]; @@ -130,10 +118,11 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, #define FUNC_NAME s_scm_instruction_list { SCM list = SCM_EOL; - struct scm_instruction *ip; - for (ip = fetch_instruction_table (); ip->opcode != scm_op_last; ip++) - if (ip->name) - list = scm_cons (ip->symname, list); + int i; + 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); return scm_reverse_x (list, SCM_EOL); } #undef FUNC_NAME @@ -143,7 +132,7 @@ SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0, "") #define FUNC_NAME s_scm_instruction_p { - return SCM_BOOL (scm_lookup_instruction_by_name (obj)); + return scm_from_bool (scm_lookup_instruction_by_name (obj) != NULL); } #undef FUNC_NAME @@ -196,13 +185,13 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0, "") #define FUNC_NAME s_scm_opcode_to_instruction { - int opcode; + scm_t_signed_bits opcode; SCM ret = SCM_BOOL_F; SCM_MAKE_VALIDATE (1, op, I_INUMP); opcode = SCM_I_INUM (op); - if (opcode < scm_op_last) + if (opcode >= 0 && opcode < SCM_VM_NUM_INSTRUCTIONS) ret = fetch_instruction_table ()[opcode].symname; if (scm_is_false (ret)) @@ -215,7 +204,8 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0, void scm_bootstrap_instructions (void) { - scm_c_register_extension ("libguile", "scm_init_instructions", + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, + "scm_init_instructions", (scm_t_extension_init_func)scm_init_instructions, NULL); } @@ -223,8 +213,6 @@ scm_bootstrap_instructions (void) void scm_init_instructions (void) { - scm_bootstrap_vm (); - #ifndef SCM_MAGIC_SNARFER #include "libguile/instructions.x" #endif