From: Giuseppe Scrivano Date: Sat, 2 Jan 2010 18:09:30 +0000 (+0100) Subject: Buffer local variables per-thread almost work now X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=41fef411b1114bfb5f95f4e6c1c917888c561abc;p=emacs.git Buffer local variables per-thread almost work now A know problem is backward propagation. A global buffer local variable modified in a thread is not seen by other threads. --- diff --git a/src/data.c b/src/data.c index d1c6c421871..e7d4a963b0d 100644 --- a/src/data.c +++ b/src/data.c @@ -95,41 +95,6 @@ static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); Lisp_Object impl_Vmost_positive_fixnum, impl_Vmost_negative_fixnum; -Lisp_Object * -blocal_get_thread_data (struct Lisp_Buffer_Local_Value *l) -{ - Lisp_Object ret = assq_no_quit (get_current_thread (), l->thread_data); - if (NILP (ret)) - { - Lisp_Object len, parent = XCDR (XCAR (l->thread_data)); - XSETFASTINT (len, 4); - ret = Fmake_vector (len, Qnil); - - /* FIXME: use the parent, not the first element. (or not?) */ - XSETFASTINT (AREF (ret, 0), AREF (parent, 0)); - BLOCAL_BUFFER_VEC (ret) = BLOCAL_BUFFER_VEC (ret); - BLOCAL_FRAME_VEC (ret) = BLOCAL_FRAME_VEC (ret); - BLOCAL_CDR_VEC (ret) = BLOCAL_CDR_VEC (parent); - ret = Fcons (get_current_thread (), ret); - l->thread_data = Fcons (ret, l->thread_data); - XTHREADLOCAL (l->realvalue)->thread_alist = - Fcons (Fcons (get_current_thread (), - XTHREADLOCAL (l->realvalue)->global), - XTHREADLOCAL (l->realvalue)->thread_alist); - } - - return &XCDR_AS_LVALUE (ret); -} - -void -blocal_set_thread_data (struct Lisp_Buffer_Local_Value *l, Lisp_Object obj) -{ - if (! NILP (l->thread_data)) - abort (); - - l->thread_data = Fcons (Fcons (get_current_thread (), obj), Qnil); -} - void circular_list_error (list) Lisp_Object list; @@ -842,6 +807,68 @@ Value, if non-nil, is a list \(interactive SPEC). */) Getting and Setting Values of Symbols ***********************************************************************/ +Lisp_Object * +blocal_getrealvalue (struct Lisp_Buffer_Local_Value *blv) +{ + return &XCDR_AS_LVALUE (ensure_thread_local (&(blv->realvalue))); +} + +Lisp_Object * +blocal_get_thread_data (struct Lisp_Buffer_Local_Value *l) +{ + Lisp_Object ret = assq_no_quit (get_current_thread (), l->thread_data); + if (NILP (ret)) + { + Lisp_Object tem, val, len, it, parent = Qnil; + + for (it = l->thread_data; !NILP (it); it = XCDR (it)) + { + Lisp_Object head = XCDR (XCAR (it)); + if (current_buffer && (BLOCAL_BUFFER_VEC (head)) + && (! l->check_frame + || EQ (selected_frame, BLOCAL_FRAME_VEC (head)))) + { + val = XCDR (BLOCAL_CDR_VEC (head)); + break; + } + + } + + + XSETFASTINT (len, 4); + ret = Fmake_vector (len, Qnil); + + if (NILP (parent)) + XSETFASTINT (AREF (ret, 0), 0); + else + XSETFASTINT (AREF (ret, 0), AREF (parent, 0)); + + BLOCAL_BUFFER_VEC (ret) = Fcurrent_buffer (); + BLOCAL_FRAME_VEC (ret) = Qnil; + + tem = Fcons (Qnil, val); + XSETCAR (tem, tem); + BLOCAL_CDR_VEC (ret) = tem; + + ret = Fcons (get_current_thread (), ret); + l->thread_data = Fcons (ret, l->thread_data); + XTHREADLOCAL (l->realvalue)->thread_alist = + Fcons (Fcons (get_current_thread (), val), + XTHREADLOCAL (l->realvalue)->thread_alist); + } + + return &XCDR_AS_LVALUE (ret); +} + +void +blocal_set_thread_data (struct Lisp_Buffer_Local_Value *l, Lisp_Object obj) +{ + if (! NILP (l->thread_data)) + abort (); + + l->thread_data = Fcons (Fcons (get_current_thread (), obj), Qnil); +} + Lisp_Object * find_variable_location (Lisp_Object *root) { @@ -852,6 +879,7 @@ find_variable_location (Lisp_Object *root) thr->thread_alist); if (!EQ (cons, Qnil)) return &XCDR_AS_LVALUE (cons); + return &thr->global; } @@ -1107,20 +1135,13 @@ store_symval_forwarding (symbol, valcontents, newval, buf) valcontents = SYMBOL_VALUE (symbol); if (BUFFER_LOCAL_VALUEP (valcontents)) { - Lisp_Object v = BLOCAL_CDR (XBUFFER_LOCAL_VALUE (valcontents)); - if (EQ (v, XCAR (v))) - BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (valcontents)) = newval; - else - { - Lisp_Object rv = XBUFFER_LOCAL_VALUE (valcontents)->realvalue; - XTHREADLOCAL (rv)->global = newval; - } + BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (valcontents)) = newval; } else if (THREADLOCALP (valcontents)) { Lisp_Object val = indirect_variable (XSYMBOL (symbol))->value; - ensure_thread_local (&val); - *find_variable_location (&val) = newval; + val = ensure_thread_local (&val); + XSETCDR (val, newval); } else SET_SYMBOL_VALUE (symbol, newval); @@ -1183,6 +1204,7 @@ swap_in_symval_forwarding (symbol, valcontents) tem1 = XCAR (BLOCAL_CDR (XBUFFER_LOCAL_VALUE (valcontents))); Fsetcdr (tem1, do_symval_forwarding (BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (valcontents)))); + /* Choose the new binding. */ tem1 = assq_no_quit (symbol, BUF_LOCAL_VAR_ALIST (current_buffer)); BLOCAL_CLEAR_FLAGS (XBUFFER_LOCAL_VALUE (valcontents)); @@ -1207,13 +1229,7 @@ swap_in_symval_forwarding (symbol, valcontents) Fcdr (tem1), NULL); } - { - Lisp_Object v = BLOCAL_CDR (XBUFFER_LOCAL_VALUE (valcontents)); - if (EQ (v, XCAR (v))) - return BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (valcontents)); - else - return XTHREADLOCAL (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)->global; - } + return BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (valcontents)); } @@ -1629,8 +1645,8 @@ The function `default-value' gets the default value and `set-default' sets it. XSETFASTINT (len, 4); val_vec = Fmake_vector (len, Qnil); if (EQ (valcontents, Qunbound)) - sym->value = Qnil; - tem = Fcons (Qnil, Fsymbol_value (variable)); + valcontents = Qnil; + tem = Fcons (Qnil, valcontents); XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; @@ -1644,10 +1660,10 @@ The function `default-value' gets the default value and `set-default' sets it. XBUFFER_LOCAL_VALUE (newval)->realvalue = allocate_misc (); XMISCTYPE (XBUFFER_LOCAL_VALUE (newval)->realvalue) = Lisp_Misc_ThreadLocal; - XTHREADLOCAL (XBUFFER_LOCAL_VALUE (newval)->realvalue)->global = Qnil; + XTHREADLOCAL (XBUFFER_LOCAL_VALUE (newval)->realvalue)->global + = valcontents; XTHREADLOCAL (XBUFFER_LOCAL_VALUE (newval)->realvalue)->thread_alist - = Fcons (Fcons (get_current_thread (), Qnil), Qnil); - BLOCAL_REALVALUE (XBUFFER_LOCAL_VALUE (newval)) = sym->value; + = Fcons (Fcons (get_current_thread (), valcontents), Qnil); sym->value = newval; } XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1; diff --git a/src/lisp.h b/src/lisp.h index 56641b3f1ec..556d00e803b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1367,6 +1367,7 @@ struct Lisp_Buffer_Local_Value Lisp_Object *blocal_get_thread_data (struct Lisp_Buffer_Local_Value *l); void blocal_set_thread_data (struct Lisp_Buffer_Local_Value *l, Lisp_Object o); +Lisp_Object *blocal_getrealvalue (struct Lisp_Buffer_Local_Value *l); #define BLOCAL_CLEAR_FLAGS_VEC(VEC) XSETFASTINT (AREF ((VEC), 0), 0) #define BLOCAL_FOUND_FOR_BUFFER_VEC(VEC) ((XFASTINT (AREF ((VEC), 0))) == 1) @@ -1386,8 +1387,7 @@ void blocal_set_thread_data (struct Lisp_Buffer_Local_Value *l, Lisp_Object o); #define BLOCAL_BUFFER(A) (BLOCAL_BUFFER_VEC (BLOCAL_THREAD_DATA (A))) #define BLOCAL_FRAME(A) (BLOCAL_FRAME_VEC (BLOCAL_THREAD_DATA (A))) #define BLOCAL_CDR(A) (BLOCAL_CDR_VEC (BLOCAL_THREAD_DATA (A))) -#define BLOCAL_REALVALUE(A) (*find_variable_location(&((A)->realvalue))) - +#define BLOCAL_REALVALUE(A) (*blocal_getrealvalue (A)) /* START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */