/* 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, &current_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");
}