Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 943d65e)
The code for binding special variables is now in inline functions.
authorJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Sat, 23 Jan 2010 22:45:21 +0000 (23:45 +0100)
committerJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Sat, 23 Jan 2010 22:45:21 +0000 (23:45 +0100)
src/c/stacks.d patch | blob | blame | history
src/h/ecl.h patch | blob | blame | history
src/h/external.h patch | blob | blame | history
src/h/stacks.h patch | blob | blame | history

diff --git a/src/c/stacks.d b/src/c/stacks.d
index a0f2bdf..7d75710 100644 (file)
--- a/src/c/stacks.d
+++ b/src/c/stacks.d
@@ -103,123 +103,6 @@ ecl_cs_set_org(cl_env_ptr env)
 
 /********************* BINDING STACK ************************/
 
-#ifdef ECL_THREADS
-static cl_index
-ecl_new_binding_index(cl_object symbol)
-{
-        cl_object pool;
-        cl_index new_index;
-        THREAD_OP_LOCK();
-       symbol->symbol.dynamic |= 1;
-        new_index = symbol->symbol.binding;
-        if (new_index == ECL_MISSING_SPECIAL_BINDING) {
-                si_set_finalizer(symbol, Ct);
-                pool = cl_core.reused_indices;
-                if (!Null(pool)) {
-                        new_index = fix(ECL_CONS_CAR(pool));
-                        cl_core.reused_indices = ECL_CONS_CDR(pool);
-                } else {
-                        new_index = ++cl_core.last_var_index;
-                }
-                symbol->symbol.binding = new_index;
-        }
-        THREAD_OP_UNLOCK();
-        return new_index;
-}
-
-static cl_object
-ecl_extend_bindings_array(cl_object vector)
-{
-        cl_index new_size = cl_core.last_var_index * 1.25;
-        cl_object new_vector = si_make_vector(Ct, MAKE_FIXNUM(new_size), Cnil,
-                                             Cnil, Cnil, Cnil);
-        ecl_copy_subarray(new_vector, 0, vector, 0, vector->vector.dim);
-        return new_vector;
-}
-
-static cl_index
-ecl_bds_special_case(cl_object s)
-{
-        cl_index index = s->symbol.binding;
-        if (index == ECL_MISSING_SPECIAL_BINDING) {
-                return ecl_new_binding_index(s);
-        } else {
-                cl_env_ptr env = ecl_process_env();
-                cl_object vector = env->bindings_array;
-                env->bindings_array = ecl_extend_bindings_array(vector);
-                env->thread_local_bindings_size = vector->vector.dim;
-                env->thread_local_bindings = vector->vector.self.t;
-                return index;
-        }
-}
-
-void
-ecl_bds_bind_special_case(cl_env_ptr env, cl_object s, cl_object value)
-{
-        cl_object *location;
-        struct bds_bd *slot;
-        cl_index index = ecl_bds_special_case(s);
-        location = env->thread_local_bindings + index;
-        slot = ++env->bds_top;
-        if (slot >= env->bds_limit) slot = ecl_bds_overflow();
-        slot->symbol = s;
-        slot->value = *location;
-        *location = value;
-}
-
-void
-ecl_bds_push(cl_env_ptr env, cl_object s)
-{
-        cl_object *location;
-        struct bds_bd *slot;
-        cl_index index = s->symbol.binding;
- AGAIN:
-        if (index >= env->thread_local_bindings_size) {
-                index = ecl_bds_special_case(s);
-                goto AGAIN;
-        }
-        location = env->thread_local_bindings + index;
-        slot = ++env->bds_top;
-        if (slot >= env->bds_limit) slot = ecl_bds_overflow();
-        slot->symbol = s;
-        slot->value = *location;
-       if (!(*location)) *location = s->symbol.value;
-}
-
-void
-ecl_bds_unwind1(cl_env_ptr env)
-{
-       struct bds_bd *slot = env->bds_top--;
-       cl_object s = slot->symbol;
-        cl_object *location = env->thread_local_bindings + s->symbol.binding;
-        *location = slot->value;
-}
-
-cl_object *
-ecl_symbol_slot(cl_env_ptr env, cl_object s)
-{
-        cl_index index = s->symbol.binding;
-        if (index < env->thread_local_bindings_size) {
-                cl_object *location = env->thread_local_bindings + index;
-                if (*location)
-                        return location;
-        }
-        return &s->symbol.value;
-}
-
-cl_object
-ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object value)
-{
-        cl_index index = s->symbol.binding;
-        if (index < env->thread_local_bindings_size) {
-                cl_object *location = env->thread_local_bindings + index;
-                if (*location)
-                        return (*location) = value;
-        }
-       return (s->symbol.value = value);
-}
-#endif
-
 void
 ecl_bds_unwind_n(cl_env_ptr env, int n)
 {
@@ -339,6 +222,148 @@ si_bds_val(cl_object arg)
        @(return ((v == OBJNULL)? ECL_UNBOUND : v))
 }
 
+#ifdef ECL_THREADS
+# ifdef ecl_bds_bind
+#  undef ecl_bds_bind
+#  undef ecl_bds_push
+#  undef ecl_bds_unwind1
+#  undef ecl_symbol_slot
+# endif
+
+static cl_index
+ecl_new_binding_index(cl_object symbol)
+{
+        cl_object pool;
+        cl_index new_index;
+        THREAD_OP_LOCK();
+       symbol->symbol.dynamic |= 1;
+        new_index = symbol->symbol.binding;
+        if (new_index == ECL_MISSING_SPECIAL_BINDING) {
+                si_set_finalizer(symbol, Ct);
+                pool = cl_core.reused_indices;
+                if (!Null(pool)) {
+                        new_index = fix(ECL_CONS_CAR(pool));
+                        cl_core.reused_indices = ECL_CONS_CDR(pool);
+                } else {
+                        new_index = ++cl_core.last_var_index;
+                }
+                symbol->symbol.binding = new_index;
+        }
+        THREAD_OP_UNLOCK();
+        return new_index;
+}
+
+static cl_object
+ecl_extend_bindings_array(cl_object vector)
+{
+        cl_index new_size = cl_core.last_var_index * 1.25;
+        cl_object new_vector = si_make_vector(Ct, MAKE_FIXNUM(new_size), Cnil,
+                                             Cnil, Cnil, Cnil);
+        ecl_copy_subarray(new_vector, 0, vector, 0, vector->vector.dim);
+        return new_vector;
+}
+
+static cl_index
+ecl_bds_special_case(cl_object s)
+{
+        cl_index index = s->symbol.binding;
+        if (index == ECL_MISSING_SPECIAL_BINDING) {
+                return ecl_new_binding_index(s);
+        } else {
+                cl_env_ptr env = ecl_process_env();
+                cl_object vector = env->bindings_array;
+                env->bindings_array = ecl_extend_bindings_array(vector);
+                env->thread_local_bindings_size = vector->vector.dim;
+                env->thread_local_bindings = vector->vector.self.t;
+                return index;
+        }
+}
+
+void
+ecl_bds_bind_special_case(cl_env_ptr env, cl_object s, cl_object value)
+{
+        cl_object *location;
+        struct bds_bd *slot;
+        cl_index index = ecl_bds_special_case(s);
+        location = env->thread_local_bindings + index;
+        slot = ++env->bds_top;
+        if (slot >= env->bds_limit) slot = ecl_bds_overflow();
+        slot->symbol = s;
+        slot->value = *location;
+        *location = value;
+}
+
+void
+ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object v)
+{
+        cl_object *location;
+        struct bds_bd *slot;
+        const cl_index index = s->symbol.binding;
+        if (index >= env->thread_local_bindings_size) {
+                ecl_bds_bind_special_case(env,s,v);
+        } else {
+                location = env->thread_local_bindings + index;
+                slot = ++env->bds_top;
+                if (slot >= env->bds_limit) slot = ecl_bds_overflow();
+                slot->symbol = s;
+                slot->value = *location;
+                *location = v;
+        }
+}
+
+void
+ecl_bds_push(cl_env_ptr env, cl_object s)
+{
+        cl_object *location;
+        struct bds_bd *slot;
+        cl_index index = s->symbol.binding;
+ AGAIN:
+        if (index >= env->thread_local_bindings_size) {
+                index = ecl_bds_special_case(s);
+                goto AGAIN;
+        }
+        location = env->thread_local_bindings + index;
+        slot = ++env->bds_top;
+        if (slot >= env->bds_limit) slot = ecl_bds_overflow();
+        slot->symbol = s;
+        slot->value = *location;
+       if (!(*location)) *location = s->symbol.value;
+}
+
+void
+ecl_bds_unwind1(cl_env_ptr env)
+{
+       struct bds_bd *slot = env->bds_top--;
+       cl_object s = slot->symbol;
+        cl_object *location = env->thread_local_bindings + s->symbol.binding;
+        *location = slot->value;
+}
+
+cl_object *
+ecl_symbol_slot(cl_env_ptr env, cl_object s)
+{
+        cl_index index = s->symbol.binding;
+        if (index < env->thread_local_bindings_size) {
+                cl_object *location = env->thread_local_bindings + index;
+                if (*location)
+                        return location;
+        }
+        return &s->symbol.value;
+}
+
+cl_object
+ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object value)
+{
+        cl_index index = s->symbol.binding;
+        if (index < env->thread_local_bindings_size) {
+                cl_object *location = env->thread_local_bindings + index;
+                if (*location)
+                        return (*location) = value;
+        }
+       return (s->symbol.value = value);
+}
+#endif
+
 /******************** INVOCATION STACK **********************/
 
 static cl_object
diff --git a/src/h/ecl.h b/src/h/ecl.h
index 7fe67bc..afb522d 100644 (file)
--- a/src/h/ecl.h
+++ b/src/h/ecl.h
@@ -73,8 +73,8 @@
 #endif /* _MSC_VER || mingw32 */
 
 #include <ecl/object.h>
-#include <ecl/stacks.h>
 #include <ecl/external.h>
+#include <ecl/stacks.h>
 #include <ecl/eval.h>
 #include <ecl/number.h>
 #ifdef LOCATIVE
diff --git a/src/h/external.h b/src/h/external.h
index 6866df8..b293510 100644 (file)
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -9,6 +9,7 @@ extern "C" {
  * Per-thread data.
  */
 
+typedef struct cl_env_struct *cl_env_ptr;
 struct cl_env_struct {
        /* Flag for disabling interrupts while we call C library functions. */
        volatile int disable_interrupts;
@@ -1486,8 +1487,8 @@ extern ECL_API cl_object si_get_limit(cl_object type);
 
 extern ECL_API cl_index ecl_progv(cl_env_ptr env, cl_object vars, cl_object values);
 extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index);
-extern ECL_API void ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr) /*__attribute__((noreturn))*/;
-extern ECL_API ecl_frame_ptr frs_sch(cl_object frame_id);
+extern ECL_API void ecl_unwind(cl_env_ptr env, struct ecl_frame *fr) /*__attribute__((noreturn))*/;
+extern ECL_API struct ecl_frame *frs_sch(cl_object frame_id);
 
 /* string.c */
 
diff --git a/src/h/stacks.h b/src/h/stacks.h
index 22ce75f..d06e6bc 100644 (file)
--- a/src/h/stacks.h
+++ b/src/h/stacks.h
@@ -41,14 +41,71 @@ typedef struct bds_bd {
 #define        ecl_bds_check(env) \
        ((env->bds_top >= env->bds_limit)? ecl_bds_overflow() : (void)0)
 
-typedef struct cl_env_struct *cl_env_ptr;
-
 extern ECL_API struct bds_bd *ecl_bds_overflow(void) /*__attribute__((noreturn))*/;
 #ifdef ECL_THREADS
-#define ECL_MISSING_SPECIAL_BINDING (~((cl_index)0))
+# define ECL_MISSING_SPECIAL_BINDING (~((cl_index)0))
 extern ECL_API void ecl_bds_bind(cl_env_ptr env, cl_object symbol, cl_object v);
 extern ECL_API void ecl_bds_bind_special_case(cl_env_ptr env,cl_object s, cl_object v);
-#define        ecl_bds_bind(env,sym,val) do {                                  \
+extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol);
+extern ECL_API void ecl_bds_unwind1(cl_env_ptr env);
+extern ECL_API cl_object *ecl_symbol_slot(cl_env_ptr env, cl_object s);
+extern ECL_API cl_object ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object v);
+# ifdef __GNUC__
+static inline void ecl_bds_bind_inl(cl_env_ptr env, cl_object s, cl_object v)
+{
+        cl_object *location;
+        struct bds_bd *slot;
+        const cl_index index = s->symbol.binding;
+        if (index >= env->thread_local_bindings_size) {
+                ecl_bds_bind_special_case(env,s,v);
+        } else {
+                location = env->thread_local_bindings + index;
+                slot = ++env->bds_top;
+                if (slot >= env->bds_limit) slot = ecl_bds_overflow();
+                slot->symbol = s;
+                slot->value = *location;
+                *location = v;
+        }
+}
+static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
+{
+        cl_object *location;
+        struct bds_bd *slot;
+        const cl_index index = s->symbol.binding;
+        if (index >= env->thread_local_bindings_size) {
+                ecl_bds_push(env, s);
+        } else {
+                location = env->thread_local_bindings + index;
+                slot = ++env->bds_top;
+                if (slot >= env->bds_limit) slot = ecl_bds_overflow();
+                slot->symbol = s;
+                slot->value = *location;
+                if (!(*location)) *location = s->symbol.value;
+        }
+}
+static inline void ecl_bds_unwind1_inl(cl_env_ptr env)
+{
+       struct bds_bd *slot = env->bds_top--;
+       cl_object s = slot->symbol;
+        cl_object *location = env->thread_local_bindings + s->symbol.binding;
+        *location = slot->value;
+}
+static inline cl_object *ecl_symbol_slot_inl(cl_env_ptr env, cl_object s)
+{
+        cl_index index = s->symbol.binding;
+        if (index < env->thread_local_bindings_size) {
+                cl_object *location = env->thread_local_bindings + index;
+                if (*location)
+                        return location;
+        }
+        return &s->symbol.value;
+}
+#  define ecl_bds_bind ecl_bds_bind_inl
+#  define ecl_bds_push ecl_bds_push_inl
+#  define ecl_bds_unwind1 ecl_bds_unwind1_inl
+#  define ecl_symbol_slot ecl_symbol_slot_inl
+# else /* __GNUC__ */
+#  define ecl_bds_bind(env,sym,val) do {                                \
                 const cl_env_ptr env_copy = (env);                      \
                 const cl_object s = (sym);                              \
                 const cl_object v = (val);                              \
@@ -65,10 +122,7 @@ extern ECL_API void ecl_bds_bind_special_case(cl_env_ptr env,cl_object s, cl_obj
                         slot->value = *location;                        \
                         *location = v; }                                \
         } while (0)
-extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol);
-extern ECL_API void ecl_bds_unwind1(cl_env_ptr env);
-extern ECL_API cl_object *ecl_symbol_slot(cl_env_ptr env, cl_object s);
-extern ECL_API cl_object ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object v);
+#endif /* !__GNUC__ */
 #define ECL_SYM_VAL(env,s) (*ecl_symbol_slot(env,s))
 #define ECL_SET(s,v) ((s)->symbol.value=(v))
 #define ECL_SETQ(env,s,v) (ecl_set_symbol(env,s,v))
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)