* Re: The concurrency branch
2012-07-05 16:07 ` Stefan Monnier
@ 2012-07-06 14:23 ` Tom Tromey
0 siblings, 0 replies; 5+ messages in thread
From: Tom Tromey @ 2012-07-06 14:23 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Andreas Schwab, emacs-devel
Stefan> I believe the basic principle can be the same, but it does need to be
Stefan> rewritten because the parts it touches have been substantially changed.
Yes, and also parts of the current branch are just wrong.
For example, the branch's idea of how to manage context switching is
just a bad one.
I started rewriting the branch, but progress is extremely slow, mostly
because I have very little, maybe negative, free time. I could use some
help.
I'm appending my current patch. It doesn't work, not even close.
Here are some notes about the patch and also the to-do list and other
assorted comments.
The patch includes changes to the GC. These could go in right away, as
they don't really require threads.
The idea behind the change is to make sure that each thread's registers
are flushed to the stack when the thread is about to "leave Emacs code"
and sleep or otherwise block. This code also notes the stack
boundaries. For example, the full plan is to change Emacs so that I/O
releases the global lock, so that other threads can run while Emacs is
blocked in 'select'. In this situation, the call to select would be
done via this register-saving trampoline.
This way the GC can later easily iterate over all threads to mark the
stacks without needing to know anything about the particular thread
implementation.
By "go in right away" I really mean "go in after suitable testing".
The patch moves a bunch of globals to struct thread_state in thread.h.
This could probably go in before the rest of the work is done, perhaps
in some slightly modified form (like changing the definition of
'current_thread').
Globals related to the internal state of the interpreter obviously have
to be thread-local. This is things like specpdl or handlerlist. Other
things like current_buffer also have to be per-thread. I put the regexp
cache there, too, though this is not really necessary.
It's perhaps mildly difficult to find out which globals must be per-thread.
I don't know of an efficient method to find them and decide.
As you can see from the appended, I didn't complete the port of the
binding code from the old branch to the new one. With the new branch my
plan was to change how some bindings are represented, to make them more
efficient; this is what the make-docfile changes are for. However, I'm
not fully convinced that this is still a good idea.
On the old branch the way this was all done was that there was a new
object that held both global- and per-thread binding information. It
kept the global value in a slot and had another slot which was an alist
mapping threads to their local "let" values.
Structures of this sort could appear in global (C) variables, or
buffer-, frame-, or keyboard-local slots.
This is probably the hardest part of the work.
The old branch has stuff like thread.c:reschedule which is just wrong.
I believe strongly that Emacs should not try to be too involved in
deciding which thread to run.
The I/O code in the old branch is also wrong. This area is trickier
than it looks.
My current thinking is that a given file descriptor should be waited on
by at most a single thread at a time. I think this would make the
internal bookkeeping simpler. However, I haven't researched it in
detail.
One problem to be aware of, that we've discussed before on the list, is
that elisp can currently run the I/O loop with local bindings in effect,
and these will affect process filters:
(while some-condition
(let ((magic 72))
(sit-for 0)))
I think a good approach would be to make processes have a new 'thread'
attribute, which by default is set to the current thread at the time the
process was created. Only the process thread can wait for I/O for that
process. The process thread could be set to nil by smarter code to
indicate that it doesn't matter, and that any thread can process that
I/O.
This approach would preserve compatibility with weird uses like the
above, while giving flexibility to new thread-aware code.
I never figured out what to do about keyboard input and multiple
threads. Letting all threads access the current keyboard seems like it
could lead to bad things.
Similarly I don't know what to do about the debugger.
It would be nice if each keyboard was its own thread. I didn't yet look
into how hard this might be.
Despite previous conversations on this topic, I think elisp will need
locking primitives. I think you just can't avoid it, even for lexical
binding -- a given closure might be invoked by multiple threads at the
same time, and then what?
I did read the paper you referenced, Stefan, whose title I forgot. The
gist was to pretend that all code is single-threaded; however it seems
to me that this paper was very optimistic about the possibility of
knowing all possible points that could context-switch. Emacs has a
great mass of elisp, code is often run indirectly via hooks or timers or
whatever; and I think an approach relying on knowing what all this code
might do -- not just now but in the future -- is doomed. We all hate
mutexes and whatnot, but I just don't see a better, implementable
alternative.
Locking is a little bit tricky since you want it to be interruptible. I
was going to add a 'thread-interrupt' primitive that would cause the
target thread to throw an exception, along the lines of what QUIT does.
I was still undecided on whether make-thread should capture the current
let bindings. We had agreed not to, but I was still going back and
forth on it, sometimes thinking that the "not" approach would lead to
obscure bugs. Dynamic scope is still prevalent in elisp, I thought, so
preserving it a bit more seems less surprising.
In the long run my intent was to make QUIT context switch periodically.
I wish I had more time to work on this branch. I think it is promising.
Realistically I think I won't have time for many years, though.
Tom
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 8156db9..cd52488 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -196,9 +196,6 @@ main (int argc, char **argv)
if (outfile == 0)
fatal ("No output file specified", "");
- if (generate_globals)
- start_globals ();
-
first_infile = i;
for (; i < argc; i++)
{
@@ -252,14 +249,6 @@ scan_file (char *filename)
else
return scan_c_file (filename, READ_TEXT);
}
-
-static void
-start_globals (void)
-{
- fprintf (outfile, "/* This file was auto-generated by make-docfile. */\n");
- fprintf (outfile, "/* DO NOT EDIT. */\n");
- fprintf (outfile, "struct emacs_globals {\n");
-}
\f
static char input_buffer[128];
@@ -564,9 +553,10 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs)
/* The types of globals. */
enum global_type
{
+ LISP_OBJECT,
+ LISP_OBJECT_NOPRO,
EMACS_INTEGER,
BOOLEAN,
- LISP_OBJECT,
INVALID
};
@@ -613,43 +603,79 @@ compare_globals (const void *a, const void *b)
{
const struct global *ga = a;
const struct global *gb = b;
+
+ /* Make Lisp_Objects come first. */
+ if (ga->type != gb->type)
+ return ga->type - gb->type;
return strcmp (ga->name, gb->name);
}
static void
write_globals (void)
{
- int i;
+ int i, out, last_lisp_object;
+
+ fprintf (outfile, "/* This file was auto-generated by make-docfile. */\n");
+ fprintf (outfile, "/* DO NOT EDIT. */\n");
+
+ fprintf (outfile, "union Lisp_Global\n");
+ fprintf (outfile, "{\n");
+ fprintf (outfile, " EMACS_INT i;\n");
+ fprintf (outfile, " Lisp_Object o;\n");
+ fprintf (outfile, " int b;\n");
+ fprintf (outfile, "};\n");
+ fprintf (outfile, "\n");
+
qsort (globals, num_globals, sizeof (struct global), compare_globals);
+ for (i = out = 0; i < num_globals; ++i)
+ {
+ while (i + 1 < num_globals
+ && !strcmp (globals[i].name, globals[i + 1].name))
+ ++i;
+ globals[out] = globals[i];
+ if (globals[out].type == LISP_OBJECT)
+ last_lisp_object = out;
+ ++out;
+ }
+ num_globals = out;
+
+ fprintf (outfile, "struct emacs_globals {\n");
+ fprintf (outfile, " union Lisp_Global definitions[%d];\n",
+ num_globals);
+ fprintf (outfile, " union Lisp_Global *pointers[%d];\n",
+ num_globals);
+ fprintf (outfile, "};\n");
+ fprintf (outfile, "\n");
+
for (i = 0; i < num_globals; ++i)
{
- char const *type;
+ const char *type;
switch (globals[i].type)
{
- case EMACS_INTEGER:
- type = "EMACS_INT";
- break;
- case BOOLEAN:
- type = "int";
- break;
- case LISP_OBJECT:
- type = "Lisp_Object";
- break;
- default:
- fatal ("not a recognized DEFVAR_", 0);
+ case EMACS_INTEGER:
+ type = "i";
+ break;
+ case BOOLEAN:
+ type = "b";
+ break;
+ case LISP_OBJECT:
+ case LISP_OBJECT_NOPRO:
+ type = "o";
+ break;
+ default:
+ fatal ("not a recognized DEFVAR_", 0);
}
- fprintf (outfile, " %s f_%s;\n", type, globals[i].name);
- fprintf (outfile, "#define %s globals.f_%s\n",
- globals[i].name, globals[i].name);
- while (i + 1 < num_globals
- && !strcmp (globals[i].name, globals[i + 1].name))
- ++i;
+ fprintf (outfile, "#define offset_%s %d\n", globals[i].name, i);
+ fprintf (outfile, "#define %s ((*(current_thread->g.pointers[%d])).%s)\n",
+ globals[i].name, i, type);
}
+ fprintf (outfile, "\n");
- fprintf (outfile, "};\n");
- fprintf (outfile, "extern struct emacs_globals globals;\n");
+ fprintf (outfile, "#define NUM_EMACS_GLOBALS %d\n", num_globals);
+ fprintf (outfile, "#define NUM_EMACS_LISP_GLOBALS %d\n",
+ last_lisp_object + 1);
}
\f
@@ -740,7 +766,23 @@ scan_c_file (char *filename, const char *mode)
if (c == 'I')
type = EMACS_INTEGER;
else if (c == 'L')
- type = LISP_OBJECT;
+ {
+ const char *p = "ISP";
+
+ while (*p)
+ {
+ c = getc (infile);
+ if (c != *p)
+ fatal ("unrecognized DEFVAR", 0);
+ ++p;
+ }
+
+ c = getc (infile);
+ if (c == '_')
+ type = LISP_OBJECT_NOPRO;
+ else
+ type = LISP_OBJECT;
+ }
else if (c == 'B')
type = BOOLEAN;
}
diff --git a/src/Makefile.in b/src/Makefile.in
index 40cfe94..46efde5 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -340,7 +340,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
eval.o floatfns.o fns.o font.o print.o lread.o \
syntax.o $(UNEXEC_OBJ) bytecode.o \
process.o gnutls.o callproc.o \
- region-cache.o sound.o atimer.o \
+ region-cache.o sound.o atimer.o thread.o \
doprnt.o intervals.o textprop.o composite.o xml.o \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
diff --git a/src/alloc.c b/src/alloc.c
index 490632f..8aaac13 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -161,6 +161,10 @@ static pthread_mutex_t alloc_mutex;
#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+/* Global variable slots that are shared between threads. */
+/* FIXME describe the binding scheme here. */
+static union Lisp_Global global_definitions[NUM_EMACS_GLOBALS];
+
/* Global variables. */
struct emacs_globals globals;
@@ -373,10 +377,6 @@ struct mem_node
enum mem_type type;
};
-/* Base address of stack. Set in main. */
-
-Lisp_Object *stack_base;
-
/* Root of the tree describing allocated Lisp memory. */
static struct mem_node *mem_root;
@@ -392,7 +392,6 @@ static struct mem_node mem_z;
static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
static void lisp_free (void *);
-static void mark_stack (void);
static int live_vector_p (struct mem_node *, void *);
static int live_buffer_p (struct mem_node *, void *);
static int live_string_p (struct mem_node *, void *);
@@ -424,15 +423,11 @@ static void check_gcpros (void);
# define DEADP(x) 0
#endif
-/* Recording what needs to be marked for gc. */
-
-struct gcpro *gcprolist;
-
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
#define NSTATICS 0x650
-static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
+static Lisp_Object *staticvec[NSTATICS] = {&globals.definitions[offset_Vpurify_flag].o};
/* Index of next unused slot in staticvec. */
@@ -4840,8 +4835,27 @@ dump_zombies (void)
would be necessary, each one starting with one byte more offset
from the stack start. */
-static void
-mark_stack (void)
+void
+mark_stack (char *bottom, char *end)
+{
+ /* This assumes that the stack is a contiguous region in memory. If
+ that's not the case, something has to be done here to iterate
+ over the stack segments. */
+ mark_memory (bottom, end);
+
+ /* Allow for marking a secondary stack, like the register stack on the
+ ia64. */
+#ifdef GC_MARK_SECONDARY_STACK
+ GC_MARK_SECONDARY_STACK ();
+#endif
+
+#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
+ check_gcpros ();
+#endif
+}
+
+void
+flush_stack_call_func (void (*func) (char *end, void *arg), void *arg)
{
void *end;
@@ -4897,20 +4911,7 @@ mark_stack (void)
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
- /* This assumes that the stack is a contiguous region in memory. If
- that's not the case, something has to be done here to iterate
- over the stack segments. */
- mark_memory (stack_base, end);
-
- /* Allow for marking a secondary stack, like the register stack on the
- ia64. */
-#ifdef GC_MARK_SECONDARY_STACK
- GC_MARK_SECONDARY_STACK ();
-#endif
-
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
- check_gcpros ();
-#endif
+ (*func) (end, arg);
}
#endif /* GC_MARK_STACK != 0 */
@@ -5471,11 +5472,10 @@ See Info node `(elisp)Garbage Collection'. */)
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
- for (bind = specpdl; bind != specpdl_ptr; bind++)
- {
- mark_object (bind->symbol);
- mark_object (bind->old_value);
- }
+ for (i = 0; i < NUM_EMACS_LISP_GLOBALS; ++i)
+ mark_object (global_definitions[i].o);
+
+ mark_threads ();
mark_terminals ();
mark_kboards ();
mark_ttys ();
@@ -5487,40 +5487,12 @@ See Info node `(elisp)Garbage Collection'. */)
}
#endif
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
- || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
- mark_stack ();
-#else
- {
- register struct gcpro *tail;
- for (tail = gcprolist; tail; tail = tail->next)
- for (i = 0; i < tail->nvars; i++)
- mark_object (tail->var[i]);
- }
- mark_byte_stack ();
- {
- struct catchtag *catch;
- struct handler *handler;
-
- for (catch = catchlist; catch; catch = catch->next)
- {
- mark_object (catch->tag);
- mark_object (catch->val);
- }
- for (handler = handlerlist; handler; handler = handler->next)
- {
- mark_object (handler->handler);
- mark_object (handler->var);
- }
- }
- mark_backtrace ();
-#endif
-
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
#endif
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
+ FIXME;
mark_stack ();
#endif
@@ -5576,7 +5548,7 @@ See Info node `(elisp)Garbage Collection'. */)
/* Clear the mark bits that we set in certain root slots. */
- unmark_byte_stack ();
+ unmark_threads ();
VECTOR_UNMARK (&buffer_defaults);
VECTOR_UNMARK (&buffer_local_symbols);
@@ -6055,6 +6027,14 @@ mark_object (Lisp_Object arg)
}
break;
+ case Lisp_Misc_ThreadLocal:
+ {
+ struct Lisp_ThreadLocal *ptr = XTHREADLOCAL (obj);
+ mark_object (ptr->global);
+ mark_object (ptr->thread_alist);
+ }
+ break;
+
default:
abort ();
}
@@ -6661,6 +6641,22 @@ die (const char *msg, const char *file, int line)
}
#endif
\f
+/* Initialize per-thread state. */
+
+void
+initialize_globals (struct emacs_globals *g)
+{
+ int i;
+
+ memset (g->definitions, 0, NUM_EMACS_GLOBALS * sizeof (union Lisp_Global));
+ for (i = 0; i < NUM_EMACS_GLOBALS; ++i)
+ {
+ if (i < NUM_EMACS_LISP_GLOBALS)
+ g->definitions[i].o = Qnil;
+ g->pointers[i] = &global_definitions[i];
+ }
+}
+
/* Initialization */
void
diff --git a/src/buffer.c b/src/buffer.c
index 89a4e26..694e8c3 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -42,8 +42,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "frame.h"
-struct buffer *current_buffer; /* the current buffer */
-
/* First buffer in chain of all buffers (in reverse order of creation).
Threaded through ->header.next.buffer. */
diff --git a/src/buffer.h b/src/buffer.h
index b1ace46..d30a00e 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -836,10 +836,6 @@ struct buffer
};
\f
-/* This points to the current buffer. */
-
-extern struct buffer *current_buffer;
-
/* This structure holds the default values of the buffer-local variables
that have special slots in each buffer.
The default value occupies the same slot in this structure
diff --git a/src/bytecode.c b/src/bytecode.c
index 08a02ea..3e6bff4 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -274,19 +274,18 @@ struct byte_stack
done. Signaling an error truncates the list analogous to
gcprolist. */
-struct byte_stack *byte_stack_list;
+/* struct byte_stack *byte_stack_list; */
\f
/* Mark objects on byte_stack_list. Called during GC. */
#if BYTE_MARK_STACK
void
-mark_byte_stack (void)
+mark_byte_stack (struct byte_stack *stack)
{
- struct byte_stack *stack;
Lisp_Object *obj;
- for (stack = byte_stack_list; stack; stack = stack->next)
+ for (; stack; stack = stack->next)
{
/* If STACK->top is null here, this means there's an opcode in
Fbyte_code that wasn't expected to GC, but did. To find out
@@ -310,11 +309,9 @@ mark_byte_stack (void)
counters. Called when GC has completed. */
void
-unmark_byte_stack (void)
+unmark_byte_stack (struct byte_stack *stack)
{
- struct byte_stack *stack;
-
- for (stack = byte_stack_list; stack; stack = stack->next)
+ for (; stack; stack = stack->next)
{
if (stack->byte_string_start != SDATA (stack->byte_string))
{
diff --git a/src/data.c b/src/data.c
index cd4b14a..020da80 100644
--- a/src/data.c
+++ b/src/data.c
@@ -94,6 +94,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
static Lisp_Object Qdefun;
+Lisp_Object Qthread;
Lisp_Object Qinteractive_form;
@@ -211,6 +212,8 @@ for example, (type-of 1) returns `integer'. */)
return Qfont_entity;
if (FONT_OBJECT_P (object))
return Qfont_object;
+ if (THREADP (object))
+ return Qthread;
return Qvector;
case Lisp_Float:
@@ -458,6 +461,16 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
return Qnil;
}
+DEFUN ("threadp", Fthreadp, Sthreadp, 1, 1, 0,
+ doc: /* Return t if OBJECT is a thread. */)
+ (Lisp_Object object)
+{
+ if (THREADP (object))
+ return Qt;
+ else
+ return Qnil;
+}
+
\f
/* Extract and set components of lists */
@@ -774,6 +787,12 @@ Value, if non-nil, is a list \(interactive SPEC). */)
Getting and Setting Values of Symbols
***********************************************************************/
+void
+blocal_unbind_thread (Lisp_Object thread)
+{
+ /* FIXME */
+}
+
/* Return the symbol holding SYMBOL's value. Signal
`cyclic-variable-indirection' if SYMBOL's chain of variable
indirections contains a loop. */
@@ -835,14 +854,18 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
switch (XFWDTYPE (valcontents))
{
case Lisp_Fwd_Int:
- XSETINT (val, *XINTFWD (valcontents)->intvar);
+ XSETINT (val, current_thread->g.pointers[XINTFWD (valcontents)->offset]->i);
return val;
case Lisp_Fwd_Bool:
- return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
+ return ((current_thread->g.pointers[XBOOLFWD (valcontents)->offset]->b)
+ ? Qt : Qnil);
case Lisp_Fwd_Obj:
- return *XOBJFWD (valcontents)->objvar;
+ return current_thread->g.pointers[XOBJFWD (valcontents)->offset]->o;
+
+ case Lisp_Fwd_Bufferdefault:
+ return *XBUFFERDEFAULT_OBJFWD (valcontents)->objvar;
case Lisp_Fwd_Buffer_Obj:
return PER_BUFFER_VALUE (current_buffer,
@@ -881,24 +904,30 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
{
case Lisp_Fwd_Int:
CHECK_NUMBER (newval);
- *XINTFWD (valcontents)->intvar = XINT (newval);
+ current_thread->g.pointers[XINTFWD (valcontents)->offset]->i
+ = XINT (newval);
break;
case Lisp_Fwd_Bool:
- *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
+ current_thread->g.pointers[XBOOLFWD (valcontents)->offset]->b
+ = !NILP (newval);
break;
case Lisp_Fwd_Obj:
- *XOBJFWD (valcontents)->objvar = newval;
+ current_thread->g.pointers[XOBJFWD (valcontents)->offset]->o = newval;
+ break;
+
+ case Lisp_Fwd_Bufferdefault:
+ *XBUFFERDEFAULT_OBJFWD (valcontents)->objvar = newval;
/* If this variable is a default for something stored
in the buffer itself, such as default-fill-column,
find the buffers that don't have local values for it
and update them. */
- if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
- && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
+ if (XBUFFERDEFAULT_OBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
+ && XBUFFERDEFAULT_OBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
{
- int offset = ((char *) XOBJFWD (valcontents)->objvar
+ int offset = ((char *) XBUFFERDEFAULT_OBJFWD (valcontents)->objvar
- (char *) &buffer_defaults);
int idx = PER_BUFFER_IDX (offset);
@@ -3095,6 +3124,7 @@ syms_of_data (void)
DEFSYM (Qchar_table, "char-table");
DEFSYM (Qbool_vector, "bool-vector");
DEFSYM (Qhash_table, "hash-table");
+ DEFSYM (Qthread, "thread");
DEFSYM (Qdefun, "defun");
@@ -3134,6 +3164,7 @@ syms_of_data (void)
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
defsubr (&Schar_or_string_p);
+ defsubr (&Sthreadp);
defsubr (&Scar);
defsubr (&Scdr);
defsubr (&Scar_safe);
diff --git a/src/emacs.c b/src/emacs.c
index 8ffbb57..e914c3c 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -709,9 +709,6 @@ void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_h
int
main (int argc, char **argv)
{
-#if GC_MARK_STACK
- Lisp_Object dummy;
-#endif
char stack_bottom_variable;
int do_initial_setlocale;
int skip_args = 0;
@@ -726,9 +723,8 @@ main (int argc, char **argv)
#endif
char *ch_to_dir;
-#if GC_MARK_STACK
- stack_base = &dummy;
-#endif
+ /* Record (approximately) where the stack begins. */
+ current_thread->stack_bottom = &stack_bottom_variable;
#if defined (USE_GTK) && defined (G_SLICE_ALWAYS_MALLOC)
/* This is used by the Cygwin build. */
@@ -759,6 +755,8 @@ main (int argc, char **argv)
unexec_init_emacs_zone ();
#endif
+ initialize_globals (¤t_thread->g);
+
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
@@ -1590,6 +1588,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_ntterm ();
#endif /* WINDOWSNT */
+ syms_of_threads ();
+
keys_of_casefiddle ();
keys_of_cmds ();
keys_of_buffer ();
diff --git a/src/eval.c b/src/eval.c
index 3360a6b..2835e0e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -42,12 +42,12 @@ struct backtrace
unsigned int debug_on_exit : 1;
};
-static struct backtrace *backtrace_list;
+/* static struct backtrace *backtrace_list; */
-#if !BYTE_MARK_STACK
-static
-#endif
-struct catchtag *catchlist;
+/* #if !BYTE_MARK_STACK */
+/* static */
+/* #endif */
+/* struct catchtag *catchlist; */
/* Chain of condition handlers currently in effect.
The elements of this chain are contained in the stack frames
@@ -55,10 +55,10 @@ struct catchtag *catchlist;
When an error is signaled (by calling Fsignal, below),
this chain is searched for an element that applies. */
-#if !BYTE_MARK_STACK
-static
-#endif
-struct handler *handlerlist;
+/* #if !BYTE_MARK_STACK */
+/* static */
+/* #endif */
+/* struct handler *handlerlist; */
#ifdef DEBUG_GCPRO
/* Count levels of GCPRO to detect failure to UNGCPRO. */
@@ -90,19 +90,19 @@ Lisp_Object Vautoload_queue;
/* Current number of specbindings allocated in specpdl. */
-ptrdiff_t specpdl_size;
+/* ptrdiff_t specpdl_size; */
/* Pointer to beginning of specpdl. */
-struct specbinding *specpdl;
+/* struct specbinding *specpdl; */
/* Pointer to first unused element in specpdl. */
-struct specbinding *specpdl_ptr;
+/* struct specbinding *specpdl_ptr; */
/* Depth in Lisp evaluations and function calls. */
-static EMACS_INT lisp_eval_depth;
+/* static EMACS_INT lisp_eval_depth; */
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
@@ -166,6 +166,16 @@ init_eval (void)
when_entered_debugger = -1;
}
+void
+mark_catchlist (struct catchtag *catch)
+{
+ for (; catch; catch = catch->next)
+ {
+ mark_object (catch->tag);
+ mark_object (catch->val);
+ }
+}
+
/* Unwind-protect function used by call_debugger. */
static Lisp_Object
@@ -1076,8 +1086,8 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
c.tag = tag;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -1131,7 +1141,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
/* Unwind the specpdl stack, and then restore the proper set of
handlers. */
unbind_to (catchlist->pdlcount, Qnil);
- handlerlist = catchlist->handlerlist;
+ handlerlist = catchlist->f_handlerlist;
catchlist = catchlist->next;
}
while (! last_time);
@@ -1152,7 +1162,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
gcpro_level = gcprolist ? gcprolist->level + 1 : 0;
#endif
backtrace_list = catch->backlist;
- lisp_eval_depth = catch->lisp_eval_depth;
+ lisp_eval_depth = catch->f_lisp_eval_depth;
_longjmp (catch->jmp, 1);
}
@@ -1256,8 +1266,8 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -1311,8 +1321,8 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -1349,8 +1359,8 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -1391,8 +1401,8 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -1433,8 +1443,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
+ c.f_handlerlist = handlerlist;
+ c.f_lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
@@ -3419,12 +3429,11 @@ If NFRAMES is more than the number of frames, the value is nil. */)
\f
#if BYTE_MARK_STACK
void
-mark_backtrace (void)
+mark_backtrace (struct backtrace *backlist)
{
- register struct backtrace *backlist;
ptrdiff_t i;
- for (backlist = backtrace_list; backlist; backlist = backlist->next)
+ for (; backlist; backlist = backlist->next)
{
mark_object (*backlist->function);
diff --git a/src/lisp.h b/src/lisp.h
index f7ec612..65b0941 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -277,6 +277,7 @@ enum Lisp_Misc_Type
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
+ Lisp_Misc_ThreadLocal,
/* This is not a type code. It is for range checking. */
Lisp_Misc_Limit
};
@@ -291,6 +292,7 @@ enum Lisp_Fwd_Type
Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
+ Lisp_Fwd_Bufferdefault, /* Fwd to a buffer default. */
};
#ifdef CHECK_LISP_OBJECT_TYPE
@@ -356,7 +358,8 @@ enum pvec_type
PVEC_SUB_CHAR_TABLE = 0x100000,
PVEC_FONT = 0x200000,
PVEC_OTHER = 0x400000,
- PVEC_TYPE_MASK = 0x7ffe00
+ PVEC_THREAD = 0x800000,
+ PVEC_TYPE_MASK = 0xfffe00
#if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
GDB. It doesn't work on OS Alpha. Moved to a variable in
@@ -496,6 +499,10 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
(eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
#define XKBOARD_OBJFWD(a) \
(eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
+#define XBUFFERDEFAULT_OBJFWD(a) \
+ (eassert (BUFFERDEFAULTFWDP (a)), &((a)->u_bufferdefault_objfwd))
+#define XTHREADLOCAL(a) \
+ (eassert (THREADLOCALP (a)), &(XMISC(a)->u_threadlocal))
/* Pseudovector types. */
@@ -517,6 +524,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
((struct Lisp_Bool_Vector *) \
XUNTAG (a, Lisp_Vectorlike)))
+#define XTHREAD(a) (eassert (THREADP (a)), (struct thread_state *) XPNTR(a))
/* Construct a Lisp_Object from a value or address. */
@@ -531,6 +539,8 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
#define XSETMISC(a, b) XSET (a, Lisp_Misc, b)
#define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
+#define XSETTHREADLOCAL(a, b) \
+ (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_ThreadLocal)
/* Pseudovector types. */
@@ -565,6 +575,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
+#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD))
/* Convenience macros for dealing with Lisp arrays. */
@@ -1261,11 +1272,11 @@ struct Lisp_Marker
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
and it means that the symbol's value really lives in the
- specified int variable. */
+ specified slot of the current threads's globals. */
struct Lisp_Intfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
- EMACS_INT *intvar;
+ int offset;
};
/* Boolean forwarding pointer to an int variable.
@@ -1275,7 +1286,7 @@ struct Lisp_Intfwd
struct Lisp_Boolfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
- int *boolvar;
+ int offset;
};
/* Forwarding pointer to a Lisp_Object variable.
@@ -1285,6 +1296,16 @@ struct Lisp_Boolfwd
struct Lisp_Objfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
+ int offset;
+ };
+
+/* Forwarding pointer to a Lisp_Object variable.
+ This is allowed only in the value cell of a symbol,
+ and it means that the symbol's value really lives in the
+ specified variable. */
+struct Lisp_Bufferdefaultfwd
+ {
+ enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bufferdefault */
Lisp_Object *objvar;
};
@@ -1398,6 +1419,15 @@ struct Lisp_Save_Value
ptrdiff_t integer;
};
+struct Lisp_ThreadLocal
+ {
+ enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_ThreadLocal */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ Lisp_Object global;
+ Lisp_Object thread_alist;
+ };
+
/* A miscellaneous object, when it's on the free list. */
struct Lisp_Free
@@ -1418,6 +1448,7 @@ union Lisp_Misc
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
+ struct Lisp_ThreadLocal u_threadlocal; /* FIXME??? */
};
union Lisp_Fwd
@@ -1427,6 +1458,7 @@ union Lisp_Fwd
struct Lisp_Objfwd u_objfwd;
struct Lisp_Buffer_Objfwd u_buffer_objfwd;
struct Lisp_Kboard_Objfwd u_kboard_objfwd;
+ struct Lisp_Bufferdefaultfwd u_bufferdefault_objfwd;
};
\f
/* Lisp floating point type */
@@ -1607,10 +1639,12 @@ typedef struct {
#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
+#define THREADLOCALP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_ThreadLocal)
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
+#define BUFFERDEFAULTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bufferdefault)
#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
@@ -1640,6 +1674,7 @@ typedef struct {
#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
+#define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD)
/* Test for image (image . spec) */
#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
@@ -1757,6 +1792,9 @@ typedef struct {
#define CHECK_OVERLAY(x) \
CHECK_TYPE (OVERLAYP (x), Qoverlayp, x)
+#define CHECK_THREAD(x) \
+ CHECK_TYPE (THREADP (x), Qthreadp, x)
+
/* Since we can't assign directly to the CAR or CDR fields of a cons
cell, use these when checking that those fields contain numbers. */
#define CHECK_NUMBER_CAR(x) \
@@ -1864,10 +1902,13 @@ extern void defsubr (struct Lisp_Subr *);
#define MANY -2
#define UNEVALLED -1
-extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
-extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
-extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
-extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
+extern void defvar_lisp (struct Lisp_Objfwd *, const char *, int);
+extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, int);
+extern void defvar_buffer_defaults (struct Lisp_Bufferdefaultfwd *,
+ const char *,
+ Lisp_Object *);
+extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int);
+extern void defvar_int (struct Lisp_Intfwd *, const char *, int);
extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
/* Macros we use to define forwarded Lisp variables.
@@ -1890,28 +1931,28 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
#define DEFVAR_LISP(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
- defvar_lisp (&o_fwd, lname, &globals.f_ ## vname); \
+ defvar_lisp (&o_fwd, lname, offset_ ## vname); \
} while (0)
#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
- defvar_lisp_nopro (&o_fwd, lname, &globals.f_ ## vname); \
+ defvar_lisp_nopro (&o_fwd, lname, offset_ ## vname); \
} while (0)
#define DEFVAR_BOOL(lname, vname, doc) \
do { \
static struct Lisp_Boolfwd b_fwd; \
- defvar_bool (&b_fwd, lname, &globals.f_ ## vname); \
+ defvar_bool (&b_fwd, lname, offset_ ## vname); \
} while (0)
#define DEFVAR_INT(lname, vname, doc) \
do { \
static struct Lisp_Intfwd i_fwd; \
- defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
+ defvar_int (&i_fwd, lname, offset_ ## vname); \
} while (0)
#define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \
do { \
- static struct Lisp_Objfwd o_fwd; \
- defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \
+ static struct Lisp_Bufferdefaultfwd b_fwd; \
+ defvar_buffer_defaults (&b_fwd, lname, &BVAR (&buffer_defaults, vname)); \
} while (0)
#define DEFVAR_KBOARD(lname, vname, doc) \
@@ -2007,8 +2048,8 @@ struct catchtag
struct gcpro *gcpro;
jmp_buf jmp;
struct backtrace *backlist;
- struct handler *handlerlist;
- EMACS_INT lisp_eval_depth;
+ struct handler *f_handlerlist;
+ EMACS_INT f_lisp_eval_depth;
ptrdiff_t pdlcount;
int poll_suppress_count;
int interrupt_input_blocked;
@@ -2916,11 +2957,11 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object *);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
-#if BYTE_MARK_STACK
-extern void mark_backtrace (void);
-#endif
extern void syms_of_eval (void);
+/* Defined in FIXME */
+extern void mark_threads (void);
+
/* Defined in editfns.c */
extern Lisp_Object Qfield;
EXFUN (Fcurrent_message, 0);
@@ -3292,9 +3333,9 @@ extern Lisp_Object Qbytecode;
extern void syms_of_bytecode (void);
extern struct byte_stack *byte_stack_list;
#if BYTE_MARK_STACK
-extern void mark_byte_stack (void);
+extern void mark_byte_stack (struct byte_stack *);
#endif
-extern void unmark_byte_stack (void);
+extern void unmark_byte_stack (struct byte_stack *);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
@@ -3664,6 +3705,12 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
} while (0)
+extern Lisp_Object Qthreadp;
+
#include "globals.h"
+extern void initialize_globals (struct emacs_globals *);
+
+#include "thread.h"
+
#endif /* EMACS_LISP_H */
diff --git a/src/lread.c b/src/lread.c
index 2cd203d..80b0c56 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3992,12 +3992,12 @@ defalias (struct Lisp_Subr *sname, char *string)
DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
defvar_int (struct Lisp_Intfwd *i_fwd,
- const char *namestring, EMACS_INT *address)
+ const char *namestring, int offset)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int;
- i_fwd->intvar = address;
+ i_fwd->offset = offset;
XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
@@ -4007,12 +4007,12 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
nil if address contains 0. */
void
defvar_bool (struct Lisp_Boolfwd *b_fwd,
- const char *namestring, int *address)
+ const char *namestring, int offset)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool;
- b_fwd->boolvar = address;
+ b_fwd->offset = offset;
XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
@@ -4026,12 +4026,26 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
can cause trouble with strings. */
void
defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
- const char *namestring, Lisp_Object *address)
+ const char *namestring, int offset)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj;
- o_fwd->objvar = address;
+ o_fwd->offset = offset;
+ XSYMBOL (sym)->declared_special = 1;
+ XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
+}
+
+void
+defvar_buffer_defaults (struct Lisp_Bufferdefaultfwd *o_fwd,
+ const char *namestring,
+ Lisp_Object *ptr)
+{
+ Lisp_Object sym;
+ sym = intern_c_string (namestring);
+ o_fwd->type = Lisp_Fwd_Bufferdefault;
+ o_fwd->objvar = ptr;
XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
@@ -4039,10 +4053,9 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
void
defvar_lisp (struct Lisp_Objfwd *o_fwd,
- const char *namestring, Lisp_Object *address)
+ const char *namestring, int offset)
{
- defvar_lisp_nopro (o_fwd, namestring, address);
- staticpro (address);
+ defvar_lisp_nopro (o_fwd, namestring, offset);
}
/* Similar but define a variable whose value is the Lisp Object stored
diff --git a/src/regex.c b/src/regex.c
index 7ef53c6..d4cc019 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1241,12 +1241,14 @@ print_double_string (where, string1, size1, string2, size2)
# define IF_LINT(Code) /* empty */
#endif
\f
+#ifndef emacs
/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
also be assigned to arbitrarily: each pattern buffer stores its own
syntax, so it can be changed between regex compilations. */
/* This has no initializer because initialized variables in Emacs
become read-only after dumping. */
reg_syntax_t re_syntax_options;
+#endif
/* Specify the precise syntax of regexps for compilation. This provides
@@ -1266,8 +1268,10 @@ re_set_syntax (reg_syntax_t syntax)
}
WEAK_ALIAS (__re_set_syntax, re_set_syntax)
+#ifndef emacs
/* Regexp to use to replace spaces, or NULL meaning don't. */
static re_char *whitespace_regexp;
+#endif
void
re_set_whitespace_regexp (const char *regexp)
@@ -4934,12 +4938,6 @@ re_match (struct re_pattern_buffer *bufp, const char *string,
WEAK_ALIAS (__re_match, re_match)
#endif /* not emacs */
-#ifdef emacs
-/* In Emacs, this is the string or buffer in which we
- are matching. It is used for looking up syntax properties. */
-Lisp_Object re_match_object;
-#endif
-
/* re_match_2 matches the compiled pattern in BUFP against the
the (virtual) concatenation of STRING1 and STRING2 (of length SIZE1
and SIZE2, respectively). We start matching at POS, and stop
diff --git a/src/search.c b/src/search.c
index 4912c0f..ba67f59 100644
--- a/src/search.c
+++ b/src/search.c
@@ -42,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
struct regexp_cache
{
struct regexp_cache *next;
- Lisp_Object regexp, whitespace_regexp;
+ Lisp_Object regexp, f_whitespace_regexp;
/* Syntax table for which the regexp applies. We need this because
of character classes. If this is t, then the compiled pattern is valid
for any syntax-table. */
@@ -77,12 +77,12 @@ static struct regexp_cache *searchbuf_head;
to call re_set_registers after compiling a new pattern or after
setting the match registers, so that the regex functions will be
able to free or re-allocate it properly. */
-static struct re_registers search_regs;
+/* static struct re_registers search_regs; */
/* The buffer in which the last search was performed, or
Qt if the last search was done in a string;
Qnil if no searching has been done yet. */
-static Lisp_Object last_thing_searched;
+/* static Lisp_Object last_thing_searched; */
/* Error condition signaled when regexp compile_pattern fails. */
static Lisp_Object Qinvalid_regexp;
@@ -129,9 +129,9 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object tra
cp->buf.multibyte = STRING_MULTIBYTE (pattern);
cp->buf.charset_unibyte = charset_unibyte;
if (STRINGP (Vsearch_spaces_regexp))
- cp->whitespace_regexp = Vsearch_spaces_regexp;
+ cp->f_whitespace_regexp = Vsearch_spaces_regexp;
else
- cp->whitespace_regexp = Qnil;
+ cp->f_whitespace_regexp = Qnil;
/* rms: I think BLOCK_INPUT is not needed here any more,
because regex.c defines malloc to call xmalloc.
@@ -231,7 +231,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object tra
&& cp->posix == posix
&& (EQ (cp->syntax_table, Qt)
|| EQ (cp->syntax_table, BVAR (current_buffer, syntax_table)))
- && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))
+ && !NILP (Fequal (cp->f_whitespace_regexp, Vsearch_spaces_regexp))
&& cp->buf.charset_unibyte == charset_unibyte)
break;
@@ -2936,9 +2936,9 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
/* If non-zero the match data have been saved in saved_search_regs
during the execution of a sentinel or filter. */
-static int search_regs_saved;
-static struct re_registers saved_search_regs;
-static Lisp_Object saved_last_thing_searched;
+/* static int search_regs_saved; */
+/* static struct re_registers saved_search_regs; */
+/* static Lisp_Object saved_last_thing_searched; */
/* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
if asynchronous code (filter or sentinel) is running. */
@@ -3042,10 +3042,10 @@ syms_of_search (void)
searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
- searchbufs[i].whitespace_regexp = Qnil;
+ searchbufs[i].f_whitespace_regexp = Qnil;
searchbufs[i].syntax_table = Qnil;
staticpro (&searchbufs[i].regexp);
- staticpro (&searchbufs[i].whitespace_regexp);
+ staticpro (&searchbufs[i].f_whitespace_regexp);
staticpro (&searchbufs[i].syntax_table);
searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
}
diff --git a/src/thread.c b/src/thread.c
new file mode 100644
index 0000000..337134f
--- /dev/null
+++ b/src/thread.c
@@ -0,0 +1,410 @@
+/* Threading code.
+ Copyright (C) 2011 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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 3 of the License, or
+(at your option) any later version.
+
+GNU Emacs 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.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+
+#include <config.h>
+#include <setjmp.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "blockinput.h"
+#include <pthread.h>
+#include <sched.h>
+#include "systime.h"
+#include "sysselect.h"
+
+void mark_catchlist (struct catchtag *);
+void mark_stack (char *, char *);
+void flush_stack_call_func (void (*) (char *, void *), void *);
+
+Lisp_Object Qthreadp;
+
+/* The main thread that exists when Emacs starts. */
+static struct thread_state primary_thread;
+
+/* A linked list of all threads in existence. */
+static struct thread_state *all_threads = &primary_thread;
+
+/* The Lisp thread object for the current thread. Note that this is
+ thread-local. */
+__thread struct thread_state *current_thread = &primary_thread;
+
+/* Only one thread can run Lisp code at a time. This thread holds the
+ global lock. */
+static pthread_mutex_t global_lock;
+
+static void
+mark_one_thread (struct thread_state *thread)
+{
+ struct specbinding *bind;
+ struct handler *handler;
+ Lisp_Object tem;
+
+ for (bind = thread->m_specpdl; bind != thread->m_specpdl_ptr; bind++)
+ {
+ mark_object (bind->symbol);
+ mark_object (bind->old_value);
+ }
+
+#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
+ || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
+ mark_stack (thread->stack_bottom, thread->stack_top);
+#else
+ {
+ struct gcpro *tail;
+ for (tail = thread->m_gcprolist; tail; tail = tail->next)
+ for (i = 0; i < tail->nvars; i++)
+ mark_object (tail->var[i]);
+ }
+#endif
+
+#if BYTE_MARK_STACK
+ if (thread->m_byte_stack_list)
+ mark_byte_stack (thread->m_byte_stack_list);
+#endif
+
+ mark_catchlist (thread->m_catchlist);
+
+ for (handler = thread->m_handlerlist; handler; handler = handler->next)
+ {
+ mark_object (handler->handler);
+ mark_object (handler->var);
+ }
+
+#if BYTE_MARK_STACK
+ mark_backtrace (thread->m_backtrace_list);
+#endif
+
+ if (thread->m_current_buffer)
+ {
+ XSETBUFFER (tem, thread->m_current_buffer);
+ mark_object (tem);
+ }
+
+ mark_object (thread->m_last_thing_searched);
+
+ if (thread->m_saved_last_thing_searched)
+ mark_object (thread->m_saved_last_thing_searched);
+}
+
+static void
+mark_threads_callback (char *end, void *ignore)
+{
+ struct thread_state *iter;
+
+ current_thread->stack_top = end;
+ for (iter = all_threads; iter; iter = iter->next_thread)
+ {
+ Lisp_Object thread_obj;
+ XSETTHREAD (thread_obj, iter);
+ mark_object (thread_obj);
+ mark_one_thread (iter);
+ }
+}
+
+void
+mark_threads (void)
+{
+ flush_stack_call_func (mark_threads_callback, NULL);
+}
+
+void
+unmark_threads (void)
+{
+ struct thread_state *iter;
+
+ for (iter = all_threads; iter; iter = iter->next_thread)
+ if (iter->m_byte_stack_list)
+ unmark_byte_stack (iter->m_byte_stack_list);
+}
+
+static void
+thread_yield_callback (char *end, void *ignore)
+{
+ pthread_mutex_unlock (&global_lock);
+ sched_yield ();
+ pthread_mutex_lock (&global_lock);
+}
+
+void
+thread_yield (void)
+{
+ flush_stack_call_func (thread_yield_callback, NULL);
+}
+
+DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0,
+ doc: /* Yield to the next thread. */)
+ (void)
+{
+ thread_yield ();
+ return other_threads_p () ? Qt : Qnil;
+}
+
+static Lisp_Object
+invoke_thread_function (void)
+{
+ Lisp_Object iter;
+
+ int count = SPECPDL_INDEX ();
+
+ Ffuncall (1, ¤t_thread->func);
+ return unbind_to (count, Qnil);
+}
+
+static Lisp_Object
+do_nothing (Lisp_Object whatever)
+{
+ return whatever;
+}
+
+static void *
+run_thread (void *state)
+{
+ struct thread_state *self = state;
+ struct thread_state **iter;
+ struct gcpro gcpro1;
+ Lisp_Object buffer;
+ char stack_pos;
+
+ self->stack_top = self->stack_bottom = &stack_pos;
+
+ self->m_specpdl_size = 50;
+ self->m_specpdl = xmalloc (self->m_specpdl_size
+ * sizeof (struct specbinding));
+ self->m_specpdl_ptr = self->m_specpdl;
+ self->pthread_id = pthread_self ();
+
+ /* Thread-local assignment. */
+ current_thread = self;
+
+ /* We need special handling to set the initial buffer. Our parent
+ thread is very likely to be using this same buffer so we will
+ typically wait for the parent thread to release it first. */
+ XSETBUFFER (buffer, self->m_current_buffer);
+ GCPRO1 (buffer);
+ self->m_current_buffer = 0;
+
+ pthread_mutex_lock (&global_lock);
+
+ set_buffer_internal (XBUFFER (buffer));
+
+ /* It might be nice to do something with errors here. */
+ internal_condition_case (invoke_thread_function, Qt, do_nothing);
+
+ {
+ /*FIXME*/
+ extern void blocal_unbind_thread (Lisp_Object);
+ blocal_unbind_thread (Fcurrent_thread ());
+ }
+
+ /* Unlink this thread from the list of all threads. */
+ for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread)
+ ;
+ *iter = (*iter)->next_thread;
+
+ xfree (self->m_specpdl);
+
+ pthread_mutex_unlock (&global_lock);
+
+ return NULL;
+}
+
+DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
+ doc: /* Start a new thread and run FUNCTION in it.
+When the function exits, the thread dies.
+NAME is the name of the thread; it defaults to nil. */)
+ (Lisp_Object function, Lisp_Object name)
+{
+ char stack_pos;
+ pthread_t thr;
+ struct thread_state *new_thread;
+ struct specbinding *p;
+
+ /* Can't start a thread in temacs. */
+ if (!initialized)
+ abort ();
+
+ new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_gcprolist,
+ PVEC_THREAD);
+ memset ((char *) new_thread + offsetof (struct thread_state, m_gcprolist),
+ 0, sizeof (struct thread_state) - offsetof (struct thread_state,
+ m_gcprolist));
+
+ new_thread->func = function;
+ new_thread->name = name;
+ new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
+ new_thread->m_saved_last_thing_searched = Qnil;
+ new_thread->m_current_buffer = current_thread->m_current_buffer;
+ new_thread->stack_bottom = &stack_pos;
+
+ initialize_globals (&new_thread->g);
+
+ /* We'll need locking here. */
+ new_thread->next_thread = all_threads;
+ all_threads = new_thread;
+
+ if (pthread_create (&thr, NULL, run_thread, new_thread))
+ {
+ /* Restore the previous situation. */
+ all_threads = all_threads->next_thread;
+ error ("Could not start a new thread");
+ }
+
+ return Qnil;
+}
+
+DEFUN ("current-thread", Fcurrent_thread, Scurrent_thread, 0, 0, 0,
+ doc: /* Return the current thread. */)
+ (void)
+{
+ Lisp_Object result;
+ XSETTHREAD (result, current_thread);
+ return result;
+}
+
+DEFUN ("thread-name", Fthread_name, Sthread_name, 1, 1, 0,
+ doc: /* Return the name of the THREAD.
+The name is the same object that was passed to `make-thread'. */)
+ (Lisp_Object thread)
+{
+ struct thread_state *tstate;
+
+ CHECK_THREAD (thread);
+ tstate = XTHREAD (thread);
+
+ return tstate->name;
+}
+
+DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
+ doc: /* Return a list of all threads. */)
+ (void)
+{
+ Lisp_Object result = Qnil;
+ struct thread_state *iter;
+
+ for (iter = all_threads; iter; iter = iter->next_thread)
+ {
+ Lisp_Object thread;
+
+ XSETTHREAD (thread, iter);
+ result = Fcons (thread, result);
+ }
+
+ return result;
+}
+
+/* Get the main thread as a lisp object. */
+Lisp_Object
+get_main_thread (void)
+{
+ Lisp_Object result;
+ XSETTHREAD (result, &primary_thread);
+ return result;
+}
+
+/* Is the current an user thread. */
+int
+user_thread_p (void)
+{
+ struct thread_state *it = all_threads;
+ pthread_t self = pthread_self ();
+ do
+ {
+ if (it->pthread_id == self)
+ return 1;
+ }
+ while (it = it->next_thread);
+
+ return 0;
+}
+
+int
+thread_select (int n, SELECT_TYPE *rfd, SELECT_TYPE *wfd, SELECT_TYPE *xfd,
+ EMACS_TIME *tmo)
+{
+ char end;
+ int ret;
+
+ /* FIXME: must call flush_stack_call_func */
+ pthread_mutex_unlock (&global_lock);
+
+ ret = select (n, rfd, wfd, xfd, tmo);
+
+ pthread_mutex_lock (&global_lock);
+
+ return ret;
+}
+
+int
+other_threads_p (void)
+{
+ return all_threads->header.next.vector ? 1 : 0;
+}
+
+Lisp_Object
+thread_notify_kill_buffer (struct buffer *b)
+{
+ Lisp_Object tem;
+ struct thread_state *it = all_threads;
+ for (; it; it = it->next_thread)
+ {
+ if (b == it->m_current_buffer)
+ {
+ Lisp_Object buf;
+ XSETBUFFER (buf, it->m_current_buffer);
+ tem = Fother_buffer (buf, Qnil, Qnil);
+ it->m_current_buffer = XBUFFER (tem);
+ if (b == it->m_current_buffer)
+ return Qnil;
+ }
+ }
+
+ return Qt;
+}
+
+void
+init_threads_once (void)
+{
+ primary_thread.header.size = PSEUDOVECSIZE (struct thread_state, m_gcprolist);
+ primary_thread.header.next.vector = NULL;
+ primary_thread.func = Qnil;
+ primary_thread.name = Qnil;
+ XSETPVECTYPE (&primary_thread, PVEC_THREAD);
+}
+
+void
+init_threads (void)
+{
+ pthread_mutex_init (&global_lock, NULL);
+ pthread_mutex_lock (&global_lock);
+
+ primary_thread.pthread_id = pthread_self ();
+ primary_thread.m_last_thing_searched = Qnil;
+ all_threads = &primary_thread;
+}
+
+void
+syms_of_threads (void)
+{
+ defsubr (&Smake_thread);
+ defsubr (&Sthread_yield);
+ defsubr (&Scurrent_thread);
+ defsubr (&Sthread_name);
+ defsubr (&Sall_threads);
+
+ DEFSYM (Qthreadp, "threadp");
+}
diff --git a/src/thread.h b/src/thread.h
new file mode 100644
index 0000000..d9942ad
--- /dev/null
+++ b/src/thread.h
@@ -0,0 +1,172 @@
+/* Thread definitions
+ Copyright (C) 2011 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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 3 of the License, or
+(at your option) any later version.
+
+GNU Emacs 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.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef THREAD_H
+#define THREAD_H
+
+#include "regex.h"
+
+struct thread_state
+{
+ struct vectorlike_header header;
+
+ /* The function we are evaluating, or 0 in the main thread. */
+ Lisp_Object func;
+
+ /* The thread's name. */
+ Lisp_Object name;
+
+ /* The buffer in which the last search was performed, or
+ Qt if the last search was done in a string;
+ Qnil if no searching has been done yet. */
+ Lisp_Object m_last_thing_searched;
+#define last_thing_searched (current_thread->m_last_thing_searched)
+
+ Lisp_Object m_saved_last_thing_searched;
+#define saved_last_thing_searched (current_thread->m_saved_last_thing_searched)
+
+ /* m_gcprolist must be the first non-lisp field. */
+ /* Recording what needs to be marked for gc. */
+ struct gcpro *m_gcprolist;
+#define gcprolist (current_thread->m_gcprolist)
+
+ /* A list of currently active byte-code execution value stacks.
+ Fbyte_code adds an entry to the head of this list before it starts
+ processing byte-code, and it removed the entry again when it is
+ done. Signalling an error truncates the list analoguous to
+ gcprolist. */
+ struct byte_stack *m_byte_stack_list;
+#define byte_stack_list (current_thread->m_byte_stack_list)
+
+ /* An address near the bottom of the stack.
+ Tells GC how to save a copy of the stack. */
+ char *stack_bottom;
+
+ /* An address near the top of the stack. */
+ char *stack_top;
+
+ struct backtrace *m_backtrace_list;
+#define backtrace_list (current_thread->m_backtrace_list)
+
+ struct catchtag *m_catchlist;
+#define catchlist (current_thread->m_catchlist)
+
+ /* Chain of condition handlers currently in effect.
+ The elements of this chain are contained in the stack frames
+ of Fcondition_case and internal_condition_case.
+ When an error is signaled (by calling Fsignal, below),
+ this chain is searched for an element that applies. */
+ struct handler *m_handlerlist;
+#define handlerlist (current_thread->m_handlerlist)
+
+ /* Count levels of GCPRO to detect failure to UNGCPRO. */
+ int m_gcpro_level;
+#define gcpro_level (current_thread->m_gcpro_level)
+
+ /* Current number of specbindings allocated in specpdl. */
+ int m_specpdl_size;
+#define specpdl_size (current_thread->m_specpdl_size)
+
+ /* Pointer to beginning of specpdl. */
+ struct specbinding *m_specpdl;
+#define specpdl (current_thread->m_specpdl)
+
+ /* Pointer to first unused element in specpdl. */
+ struct specbinding *m_specpdl_ptr;
+#define specpdl_ptr (current_thread->m_specpdl_ptr)
+
+ /* Depth in Lisp evaluations and function calls. */
+ int m_lisp_eval_depth;
+#define lisp_eval_depth (current_thread->m_lisp_eval_depth)
+
+ /* This points to the current buffer. */
+ struct buffer *m_current_buffer;
+#define current_buffer (current_thread->m_current_buffer)
+
+ /* Every call to re_match, etc., must pass &search_regs as the regs
+ argument unless you can show it is unnecessary (i.e., if re_match
+ is certainly going to be called again before region-around-match
+ can be called).
+
+ Since the registers are now dynamically allocated, we need to make
+ sure not to refer to the Nth register before checking that it has
+ been allocated by checking search_regs.num_regs.
+
+ The regex code keeps track of whether it has allocated the search
+ buffer using bits in the re_pattern_buffer. This means that whenever
+ you compile a new pattern, it completely forgets whether it has
+ allocated any registers, and will allocate new registers the next
+ time you call a searching or matching function. Therefore, we need
+ to call re_set_registers after compiling a new pattern or after
+ setting the match registers, so that the regex functions will be
+ able to free or re-allocate it properly. */
+ struct re_registers m_search_regs;
+#define search_regs (current_thread->m_search_regs)
+
+ /* If non-zero the match data have been saved in saved_search_regs
+ during the execution of a sentinel or filter. */
+ int m_search_regs_saved;
+#define search_regs_saved (current_thread->m_search_regs_saved)
+
+ struct re_registers m_saved_search_regs;
+#define saved_search_regs (current_thread->m_saved_search_regs)
+
+ /* This is the string or buffer in which we
+ are matching. It is used for looking up syntax properties. */
+ Lisp_Object m_re_match_object;
+#define re_match_object (current_thread->m_re_match_object)
+
+ /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
+ also be assigned to arbitrarily: each pattern buffer stores its own
+ syntax, so it can be changed between regex compilations. */
+ reg_syntax_t m_re_syntax_options;
+#define re_syntax_options (current_thread->m_re_syntax_options)
+
+ /* Regexp to use to replace spaces, or NULL meaning don't. */
+ /*re_char*/ unsigned char *m_whitespace_regexp;
+#define whitespace_regexp (current_thread->m_whitespace_regexp)
+
+
+ struct thread_state *next_thread;
+
+ pthread_t pthread_id;
+
+ struct emacs_globals g;
+};
+
+extern __thread struct thread_state *current_thread;
+
+extern void init_threads (void);
+
+extern void init_threads_once (void);
+
+extern void thread_yield (void);
+
+extern void syms_of_threads (void);
+
+extern Lisp_Object Fcurrent_thread (void);
+
+extern Lisp_Object get_main_thread (void);
+
+extern int other_threads_p (void);
+
+extern int user_thread_p (void);
+
+extern void unmark_threads (void);
+
+#endif /* THREAD_H */
diff --git a/src/window.c b/src/window.c
index 9420d73..61542e9 100644
--- a/src/window.c
+++ b/src/window.c
@@ -5315,7 +5315,7 @@ struct save_window_data
struct vectorlike_header header;
Lisp_Object selected_frame;
Lisp_Object current_window;
- Lisp_Object current_buffer;
+ Lisp_Object f_current_buffer;
Lisp_Object minibuf_scroll_window;
Lisp_Object minibuf_selected_window;
Lisp_Object root_window;
@@ -5396,7 +5396,7 @@ the return value is nil. Otherwise the value is t. */)
data = (struct save_window_data *) XVECTOR (configuration);
saved_windows = XVECTOR (data->saved_windows);
- new_current_buffer = data->current_buffer;
+ new_current_buffer = data->f_current_buffer;
if (NILP (BVAR (XBUFFER (new_current_buffer), name)))
new_current_buffer = Qnil;
else
@@ -6028,7 +6028,7 @@ saved by this function. */)
data->frame_tool_bar_lines = FRAME_TOOL_BAR_LINES (f);
data->selected_frame = selected_frame;
data->current_window = FRAME_SELECTED_WINDOW (f);
- XSETBUFFER (data->current_buffer, current_buffer);
+ XSETBUFFER (data->f_current_buffer, current_buffer);
data->minibuf_scroll_window = minibuf_level > 0 ? Vminibuf_scroll_window : Qnil;
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
@@ -6431,7 +6431,7 @@ compare_window_configurations (Lisp_Object configuration1, Lisp_Object configura
|| d1->frame_lines != d2->frame_lines
|| d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
|| !EQ (d1->selected_frame, d2->selected_frame)
- || !EQ (d1->current_buffer, d2->current_buffer)
+ || !EQ (d1->f_current_buffer, d2->f_current_buffer)
|| (!ignore_positions
&& (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
|| !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
^ permalink raw reply related [flat|nested] 5+ messages in thread