source: trunk/source/lisp-kernel/thread_manager.c @ 11231

Last change on this file since 11231 was 11231, checked in by gb, 12 years ago

In windows suspend_tcr(): writing to a (new, uncommitted) page on
another thread's c stack doesn't work on Windows. Since we can
only have one active suspend_suspend context, pre-allocated one
and store a pointer to it in tcr.native_thread_info.

Still need to handle the interrupt case (where there can be
more than one pending interrupt context on a thread), and need
to verify that exception handling (where there's only one thread
involved) works.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 53.3 KB
Line 
1/*
2   Copyright (C) 1994-2001 Digitool, Inc
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17
18#include "Threads.h"
19
20
21typedef struct {
22  TCR *tcr;
23  natural vsize, tsize;
24  void *created;
25} thread_activation;
26
27#ifdef HAVE_TLS
28__thread TCR __attribute__ ((aligned (16))) current_tcr;
29#endif
30
31extern natural
32store_conditional(natural*, natural, natural);
33
34extern signed_natural
35atomic_swap(signed_natural*, signed_natural);
36
37#ifdef USE_FUTEX
38#define futex_wait(futex,val) syscall(SYS_futex,futex,FUTEX_WAIT,val)
39#define futex_wake(futex,n) syscall(SYS_futex,futex,FUTEX_WAKE,n)
40#define FUTEX_AVAIL (0)
41#define FUTEX_LOCKED (1)
42#define FUTEX_CONTENDED (2)
43#endif
44
45#ifdef WINDOWS
46extern pc spentry_start, spentry_end,subprims_start,subprims_end;
47extern pc restore_windows_context_start, restore_windows_context_end,
48  restore_windows_context_load_rcx, restore_windows_context_iret;
49
50extern void interrupt_handler(int, siginfo_t *, ExceptionInformation *);
51
52void CALLBACK
53nullAPC(ULONG_PTR arg) 
54{
55}
56 
57BOOL (*pCancelIoEx)(HANDLE, OVERLAPPED*) = NULL;
58
59
60extern void *windows_find_symbol(void*, char*);
61
62int
63raise_thread_interrupt(TCR *target)
64{
65  /* GCC doesn't align CONTEXT corrcectly */
66  char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
67  CONTEXT  *pcontext;
68  HANDLE hthread = (HANDLE)(target->osid);
69  pc where;
70  area *cs = target->cs_area, *ts = target->cs_area;
71  DWORD rc;
72  BOOL io_pending;
73
74  pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
75  rc = SuspendThread(hthread);
76  if (rc == -1) {
77    return -1;
78  }
79  /* What if the suspend count is > 1 at this point ?  I don't think
80     that that matters, but I'm not sure */
81  pcontext->ContextFlags = CONTEXT_ALL;
82  rc = GetThreadContext(hthread, pcontext);
83  if (rc == 0) {
84    return ESRCH;
85  }
86
87  where = (pc)(xpPC(pcontext));
88 
89  if ((target->valence != TCR_STATE_LISP) ||
90      (TCR_INTERRUPT_LEVEL(target) < 0) ||
91      (target->unwinding != 0) ||
92      (!((where < (pc)lisp_global(HEAP_END)) &&
93         (where >= (pc)lisp_global(HEAP_START))) &&
94       !((where < spentry_end) && (where >= spentry_start)) &&
95       !((where < subprims_end) && (where >= subprims_start)) &&
96       !((where < (pc) 0x16000) &&
97         (where >= (pc) 0x15000)) &&
98       !((where < (pc) (ts->high)) &&
99         (where >= (pc) (ts->low))))) {
100    /* If the thread's in a blocking syscall, it'd be nice to
101       get it out of that state here. */
102    GetThreadIOPendingFlag(hthread,&io_pending);
103    target->interrupt_pending = (1LL << (nbits_in_word - 1LL));
104    if (io_pending) {
105      pending_io * pending = (pending_io *) (target->pending_io_info);
106      if (pending) {
107        if (pCancelIoEx) {
108          pCancelIoEx(pending->h, pending->o);
109        } else {
110          CancelIo(pending->h);
111        }
112      }
113    }
114    QueueUserAPC(nullAPC, hthread, 0);
115    ResumeThread(hthread);
116    return 0;
117  } else {
118    /* Thread is running lisp code with interupts enabled.  Set it
119       so that it calls out and then returns to the context,
120       handling any necessary pc-lusering. */
121    LispObj foreign_rsp = (((LispObj)(target->foreign_sp))-0x200)&~15;
122    CONTEXT *icontext = ((CONTEXT *) foreign_rsp) -1;
123    icontext = (CONTEXT *)(((LispObj)icontext)&~15);
124   
125    *icontext = *pcontext;
126
127#ifdef WIN_64   
128    xpGPR(pcontext,REG_RCX) = SIGNAL_FOR_PROCESS_INTERRUPT;
129    xpGPR(pcontext,REG_RDX) = 0;
130    xpGPR(pcontext,REG_R8) = (LispObj) icontext;
131    xpGPR(pcontext,REG_RSP) = (LispObj)(((LispObj *)icontext)-1);
132    *(((LispObj *)icontext)-1) = (LispObj)raise_thread_interrupt;
133#else
134    {
135      LispObj *p = (LispObj *)icontext;
136      p -= 4;
137      p[0] = SIGNAL_FOR_PROCESS_INTERRUPT;
138      p[1] = 0;
139      p[2] = (DWORD)icontext;
140      *(--p) = (LispObj)raise_thread_interrupt;;
141      xpGPR(pcontext,Isp) = (DWORD)p;
142#ifdef WIN32_ES_HACK
143      pcontext->SegEs = pcontext->SegDs;
144#endif
145    }
146#endif
147    pcontext->EFlags &= ~0x400;  /* clear direction flag */
148    xpPC(pcontext) = (LispObj)interrupt_handler;
149    SetThreadContext(hthread,pcontext);
150    ResumeThread(hthread);
151    return 0;
152  }
153}
154#else
155int
156raise_thread_interrupt(TCR *target)
157{
158  pthread_t thread = (pthread_t)target->osid;
159#ifdef DARWIN_not_yet
160  if (use_mach_exception_handling) {
161    return mach_raise_thread_interrupt(target);
162  }
163#endif
164  if (thread != (pthread_t) 0) {
165    return pthread_kill(thread, SIGNAL_FOR_PROCESS_INTERRUPT);
166  }
167  return ESRCH;
168}
169#endif
170
171signed_natural
172atomic_incf_by(signed_natural *ptr, signed_natural by)
173{
174  signed_natural old, new;
175  do {
176    old = *ptr;
177    new = old+by;
178  } while (store_conditional((natural *)ptr, (natural) old, (natural) new) !=
179           (natural) old);
180  return new;
181}
182
183signed_natural
184atomic_incf(signed_natural *ptr)
185{
186  return atomic_incf_by(ptr, 1);
187}
188
189signed_natural
190atomic_decf(signed_natural *ptr)
191{
192  signed_natural old, new;
193  do {
194    old = *ptr;
195    new = old == 0 ? old : old-1;
196  } while (store_conditional((natural *)ptr, (natural) old, (natural) new) !=
197           (natural) old);
198  return old-1;
199}
200
201
202#ifndef USE_FUTEX
203int spin_lock_tries = 1;
204
205void
206get_spin_lock(signed_natural *p, TCR *tcr)
207{
208  int i, n = spin_lock_tries;
209 
210  while (1) {
211    for (i = 0; i < n; i++) {
212      if (atomic_swap(p,(signed_natural)tcr) == 0) {
213        return;
214      }
215    }
216#ifndef WINDOWS
217    sched_yield();
218#endif
219  }
220}
221#endif
222
223#ifndef USE_FUTEX
224int
225lock_recursive_lock(RECURSIVE_LOCK m, TCR *tcr)
226{
227
228  if (tcr == NULL) {
229    tcr = get_tcr(true);
230  }
231  if (m->owner == tcr) {
232    m->count++;
233    return 0;
234  }
235  while (1) {
236    LOCK_SPINLOCK(m->spinlock,tcr);
237    ++m->avail;
238    if (m->avail == 1) {
239      m->owner = tcr;
240      m->count = 1;
241      RELEASE_SPINLOCK(m->spinlock);
242      break;
243    }
244    RELEASE_SPINLOCK(m->spinlock);
245    SEM_WAIT_FOREVER(m->signal);
246  }
247  return 0;
248}
249
250#else /* USE_FUTEX */
251
252static void inline
253lock_futex(signed_natural *p)
254{
255 
256  while (1) {
257    if (store_conditional(p,FUTEX_AVAIL,FUTEX_LOCKED) == FUTEX_AVAIL) {
258      return;
259    }
260    while (1) {
261      if (atomic_swap(p,FUTEX_CONTENDED) == FUTEX_AVAIL) {
262        return;
263      }
264      futex_wait(p,FUTEX_CONTENDED);
265    }
266  }
267}
268
269static void inline
270unlock_futex(signed_natural *p)
271{
272  if (atomic_decf(p) != FUTEX_AVAIL) {
273    *p = FUTEX_AVAIL;
274    futex_wake(p,INT_MAX);
275  }
276}
277   
278int
279lock_recursive_lock(RECURSIVE_LOCK m, TCR *tcr)
280{
281  if (tcr == NULL) {
282    tcr = get_tcr(true);
283  }
284  if (m->owner == tcr) {
285    m->count++;
286    return 0;
287  }
288  lock_futex(&m->avail);
289  m->owner = tcr;
290  m->count = 1;
291  return 0;
292}
293#endif /* USE_FUTEX */
294
295
296#ifndef USE_FUTEX 
297int
298unlock_recursive_lock(RECURSIVE_LOCK m, TCR *tcr)
299{
300  int ret = EPERM, pending;
301
302  if (tcr == NULL) {
303    tcr = get_tcr(true);
304  }
305
306  if (m->owner == tcr) {
307    --m->count;
308    if (m->count == 0) {
309      LOCK_SPINLOCK(m->spinlock,tcr);
310      m->owner = NULL;
311      pending = m->avail-1 + m->waiting;     /* Don't count us */
312      m->avail = 0;
313      --pending;
314      if (pending > 0) {
315        m->waiting = pending;
316      } else {
317        m->waiting = 0;
318      }
319      RELEASE_SPINLOCK(m->spinlock);
320      if (pending >= 0) {
321        SEM_RAISE(m->signal);
322      }
323    }
324    ret = 0;
325  }
326  return ret;
327}
328#else /* USE_FUTEX */
329int
330unlock_recursive_lock(RECURSIVE_LOCK m, TCR *tcr)
331{
332  int ret = EPERM;
333
334   if (tcr == NULL) {
335    tcr = get_tcr(true);
336  }
337
338  if (m->owner == tcr) {
339    --m->count;
340    if (m->count == 0) {
341      m->owner = NULL;
342      unlock_futex(&m->avail);
343    }
344    ret = 0;
345  }
346  return ret;
347}
348#endif /* USE_FUTEX */
349
350void
351destroy_recursive_lock(RECURSIVE_LOCK m)
352{
353#ifndef USE_FUTEX
354  destroy_semaphore((void **)&m->signal);
355#endif
356  postGCfree((void *)(m->malloced_ptr));
357}
358
359/*
360  If we're already the owner (or if the lock is free), lock it
361  and increment the lock count; otherwise, return EBUSY without
362  waiting.
363*/
364
365#ifndef USE_FUTEX
366int
367recursive_lock_trylock(RECURSIVE_LOCK m, TCR *tcr, int *was_free)
368{
369  TCR *owner = m->owner;
370
371  LOCK_SPINLOCK(m->spinlock,tcr);
372  if (owner == tcr) {
373    m->count++;
374    if (was_free) {
375      *was_free = 0;
376      RELEASE_SPINLOCK(m->spinlock);
377      return 0;
378    }
379  }
380  if (store_conditional((natural*)&(m->avail), 0, 1) == 0) {
381    m->owner = tcr;
382    m->count = 1;
383    if (was_free) {
384      *was_free = 1;
385    }
386    RELEASE_SPINLOCK(m->spinlock);
387    return 0;
388  }
389
390  RELEASE_SPINLOCK(m->spinlock);
391  return EBUSY;
392}
393#else
394int
395recursive_lock_trylock(RECURSIVE_LOCK m, TCR *tcr, int *was_free)
396{
397  TCR *owner = m->owner;
398
399  if (owner == tcr) {
400    m->count++;
401    if (was_free) {
402      *was_free = 0;
403      return 0;
404    }
405  }
406  if (store_conditional((natural*)&(m->avail), 0, 1) == 0) {
407    m->owner = tcr;
408    m->count = 1;
409    if (was_free) {
410      *was_free = 1;
411    }
412    return 0;
413  }
414
415  return EBUSY;
416}
417#endif
418
419void
420sem_wait_forever(SEMAPHORE s)
421{
422  int status;
423
424  do {
425#ifdef USE_MACH_SEMAPHORES
426    mach_timespec_t q = {1,0};
427    status = SEM_TIMEDWAIT(s,q);
428#endif
429#ifdef USE_POSIX_SEMAPHORES
430    struct timespec q;
431    gettimeofday((struct timeval *)&q, NULL);
432    q.tv_sec += 1;
433    status = SEM_TIMEDWAIT(s,&q);
434#endif
435#ifdef USE_WINDOWS_SEMAPHORES
436    status = (WaitForSingleObject(s,1000L) == WAIT_TIMEOUT) ? 1 : 0;
437#endif
438  } while (status != 0);
439}
440
441int
442wait_on_semaphore(void *s, int seconds, int millis)
443{
444#ifdef USE_POSIX_SEMAPHORES
445  int nanos = (millis % 1000) * 1000000;
446  int status;
447
448  struct timespec q;
449  gettimeofday((struct timeval *)&q, NULL);
450  q.tv_nsec *= 1000L;  /* microseconds -> nanoseconds */
451   
452  q.tv_nsec += nanos;
453  if (q.tv_nsec >= 1000000000L) {
454    q.tv_nsec -= 1000000000L;
455    seconds += 1;
456  }
457  q.tv_sec += seconds;
458  status = SEM_TIMEDWAIT(s, &q);
459  if (status < 0) {
460    return errno;
461  }
462  return status;
463#endif
464#ifdef USE_MACH_SEMAPHORES
465  int nanos = (millis % 1000) * 1000000;
466  mach_timespec_t q = {seconds, nanos};
467  int status = SEM_TIMEDWAIT(s, q);
468
469 
470  switch (status) {
471  case 0: return 0;
472  case KERN_OPERATION_TIMED_OUT: return ETIMEDOUT;
473  case KERN_ABORTED: return EINTR;
474  default: return EINVAL;
475  }
476#endif
477#ifdef USE_WINDOWS_SEMAPHORES
478  switch (WaitForSingleObjectEx(s, seconds*1000L+(DWORD)millis,true)) {
479  case WAIT_OBJECT_0:
480    return 0;
481  case WAIT_TIMEOUT:
482    return /* ETIMEDOUT */ WAIT_TIMEOUT;
483  case WAIT_IO_COMPLETION:
484    return EINTR;
485  default:
486    break;
487  }
488  return EINVAL;
489
490#endif
491}
492
493
494int
495semaphore_maybe_timedwait(void *s, struct timespec *t)
496{
497  if (t) {
498    return wait_on_semaphore(s, t->tv_sec, t->tv_nsec/1000000L);
499  }
500  SEM_WAIT_FOREVER(s);
501  return 0;
502}
503
504void
505signal_semaphore(SEMAPHORE s)
506{
507  SEM_RAISE(s);
508}
509
510 
511#ifdef WINDOWS
512LispObj
513current_thread_osid()
514{
515  TCR *tcr = get_tcr(false);
516  LispObj current = 0;
517
518  if (tcr) {
519    current = tcr->osid;
520  }
521  if (current == 0) {
522    DuplicateHandle(GetCurrentProcess(),
523                    GetCurrentThread(),
524                    GetCurrentProcess(),
525                    (LPHANDLE)(&current),
526                    0,
527                    FALSE,
528                    DUPLICATE_SAME_ACCESS);
529    if (tcr) {
530      tcr->osid = current;
531    }
532  }
533  return current;
534}
535#else
536LispObj
537current_thread_osid()
538{
539  return (LispObj)ptr_to_lispobj(pthread_self());
540}
541#endif
542
543
544int thread_suspend_signal = 0, thread_resume_signal = 0;
545
546
547
548void
549linux_exception_init(TCR *tcr)
550{
551}
552
553
554TCR *
555get_interrupt_tcr(Boolean create)
556{
557  return get_tcr(create);
558}
559 
560void
561suspend_resume_handler(int signo, siginfo_t *info, ExceptionInformation *context)
562{
563#ifdef DARWIN_GS_HACK
564  Boolean gs_was_tcr = ensure_gs_pthread();
565#endif
566  TCR *tcr = get_interrupt_tcr(false);
567
568  if (TCR_INTERRUPT_LEVEL(tcr) <= (-2<<fixnumshift)) {
569    SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
570  } else {
571    tcr->suspend_context = context;
572    SEM_RAISE(tcr->suspend);
573    SEM_WAIT_FOREVER(tcr->resume);
574    tcr->suspend_context = NULL;
575  }
576#ifdef DARWIN_GS_HACK
577  if (gs_was_tcr) {
578    set_gs_address(tcr);
579  }
580#endif
581  SIGRETURN(context);
582}
583
584 
585
586/*
587  'base' should be set to the bottom (origin) of the stack, e.g., the
588  end from which it grows.
589*/
590 
591#ifdef WINDOWS
592void
593os_get_current_thread_stack_bounds(void **base, natural *size)
594{
595  natural natbase;
596  MEMORY_BASIC_INFORMATION info;
597  void *addr = (void *)current_stack_pointer();
598 
599  VirtualQuery(addr, &info, sizeof(info));
600  natbase = (natural)info.BaseAddress+info.RegionSize;
601  *size = natbase - (natural)(info.AllocationBase);
602  *base = (void *)natbase;
603}
604#else
605void
606os_get_current_thread_stack_bounds(void **base, natural *size)
607{
608  pthread_t p = pthread_self();
609#ifdef DARWIN
610  *base = pthread_get_stackaddr_np(p);
611  *size = pthread_get_stacksize_np(p);
612#endif
613#ifdef LINUX
614  pthread_attr_t attr;
615
616  pthread_getattr_np(p,&attr);
617  pthread_attr_getstack(&attr, base, size);
618  pthread_attr_destroy(&attr);
619  *(natural *)base += *size;
620#endif
621#ifdef FREEBSD
622  pthread_attr_t attr;
623  void * temp_base;
624  size_t temp_size;
625 
626
627  pthread_attr_init(&attr); 
628  pthread_attr_get_np(p, &attr);
629  pthread_attr_getstackaddr(&attr,&temp_base);
630  pthread_attr_getstacksize(&attr,&temp_size);
631  *base = (void *)((natural)temp_base + temp_size);
632  *size = temp_size;
633  pthread_attr_destroy(&attr);
634#endif
635#ifdef SOLARIS
636  stack_t st;
637 
638  thr_stksegment(&st);
639  *size = st.ss_size;
640  *base = st.ss_sp;
641 
642#endif
643}
644#endif
645
646void *
647new_semaphore(int count)
648{
649#ifdef USE_POSIX_SEMAPHORES
650  sem_t *s = malloc(sizeof(sem_t));
651  sem_init(s, 0, count);
652  return s;
653#endif
654#ifdef USE_MACH_SEMAPHORES
655  semaphore_t s = (semaphore_t)0;
656  semaphore_create(mach_task_self(),&s, SYNC_POLICY_FIFO, count);
657  return (void *)(natural)s;
658#endif
659#ifdef USE_WINDOWS_SEMAPHORES
660  return CreateSemaphore(NULL, count, 0x7fffL, NULL);
661#endif
662}
663
664RECURSIVE_LOCK
665new_recursive_lock()
666{
667  extern int cache_block_size;
668  void *p = calloc(1,sizeof(_recursive_lock)+cache_block_size-1);
669  RECURSIVE_LOCK m = NULL;
670#ifndef USE_FUTEX
671  void *signal = new_semaphore(0);
672#endif
673  if (p) {
674    m = (RECURSIVE_LOCK) ((((natural)p)+cache_block_size-1) & (~(cache_block_size-1)));
675    m->malloced_ptr = p;
676  }
677
678#ifdef USE_FUTEX
679  if (m) {
680    return m;
681  }
682#else
683  if (m && signal) {
684    m->signal = signal;
685    return m;
686  }
687  if (m) {
688    free(p);
689  }
690  if (signal) {
691    destroy_semaphore(&signal);
692  }
693#endif
694  return NULL;
695}
696
697void
698destroy_semaphore(void **s)
699{
700  if (*s) {
701#ifdef USE_POSIX_SEMAPHORES
702    sem_destroy((sem_t *)*s);
703    free(*s);
704#endif
705#ifdef USE_MACH_SEMAPHORES
706    semaphore_destroy(mach_task_self(),((semaphore_t)(natural) *s));
707#endif
708#ifdef USE_WINDOWS_SEMAPHORES
709    CloseHandle(*s);
710#endif
711    *s=NULL;
712  }
713}
714
715#ifdef WINDOWS
716void
717tsd_set(LispObj key, void *datum)
718{
719  TlsSetValue((DWORD)key, datum);
720}
721
722void *
723tsd_get(LispObj key)
724{
725  return TlsGetValue((DWORD)key);
726}
727#else
728void
729tsd_set(LispObj key, void *datum)
730{
731  pthread_setspecific((pthread_key_t)key, datum);
732}
733
734void *
735tsd_get(LispObj key)
736{
737  return pthread_getspecific((pthread_key_t)key);
738}
739#endif
740
741void
742dequeue_tcr(TCR *tcr)
743{
744  TCR *next, *prev;
745
746  next = tcr->next;
747  prev = tcr->prev;
748
749  prev->next = next;
750  next->prev = prev;
751  tcr->prev = tcr->next = NULL;
752#ifdef X8664
753  tcr->linear = NULL;
754#endif
755}
756 
757void
758enqueue_tcr(TCR *new)
759{
760  TCR *head, *tail;
761 
762  LOCK(lisp_global(TCR_AREA_LOCK),new);
763  head = (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR));
764  tail = head->prev;
765  tail->next = new;
766  head->prev = new;
767  new->prev = tail;
768  new->next = head;
769  UNLOCK(lisp_global(TCR_AREA_LOCK),new);
770}
771
772#ifdef WIN_32
773TCR *
774allocate_tcr()
775{
776  void *p = calloc(1,sizeof(TCR)+15);
777  TCR *tcr = (TCR *)((((natural)p)+15)&~15);
778
779  tcr->allocated = p;
780  return tcr;
781}
782#else
783TCR *
784allocate_tcr()
785{
786  TCR *tcr, *chain = NULL, *next;
787#ifdef DARWIN
788  extern Boolean use_mach_exception_handling;
789  kern_return_t kret;
790  mach_port_t
791    thread_exception_port,
792    task_self = mach_task_self();
793#endif
794  for (;;) {
795    tcr = calloc(1, sizeof(TCR));
796#ifdef DARWIN
797#if WORD_SIZE == 64
798    if (((unsigned)((natural)tcr)) != ((natural)tcr)) {
799      tcr->next = chain;
800      chain = tcr;
801      continue;
802    }
803#endif
804    if (use_mach_exception_handling) {
805      thread_exception_port = (mach_port_t)((natural)tcr);
806      kret = mach_port_allocate_name(task_self,
807                                     MACH_PORT_RIGHT_RECEIVE,
808                                     thread_exception_port);
809    } else {
810      kret = KERN_SUCCESS;
811    }
812
813    if (kret != KERN_SUCCESS) {
814      tcr->next = chain;
815      chain = tcr;
816      continue;
817    }
818#endif
819    for (next = chain; next;) {
820      next = next->next;
821      free(chain);
822    }
823    return tcr;
824  }
825}
826#endif
827
828#ifdef X8664
829#ifdef LINUX
830#include <asm/prctl.h>
831#include <sys/prctl.h>
832#endif
833#ifdef FREEBSD
834#include <machine/sysarch.h>
835#endif
836
837void
838setup_tcr_extra_segment(TCR *tcr)
839{
840#ifdef FREEBSD
841  amd64_set_gsbase(tcr);
842#endif
843#ifdef LINUX
844  arch_prctl(ARCH_SET_GS, (natural)tcr);
845#endif
846#ifdef DARWIN
847  /* There's no way to do this yet.  See DARWIN_GS_HACK */
848  /* darwin_set_x8664_fs_reg(tcr); */
849#endif
850#ifdef SOLARIS
851  /* Chris Curtis found this and suggested the use of syscall here */
852  syscall(SYS_lwp_private,_LWP_SETPRIVATE, _LWP_GSBASE, tcr);
853#endif
854}
855
856#endif
857
858#ifdef X8632
859
860#ifdef DARWIN
861#include <architecture/i386/table.h>
862#include <architecture/i386/sel.h>
863#include <i386/user_ldt.h>
864
865void setup_tcr_extra_segment(TCR *tcr)
866{
867    uintptr_t addr = (uintptr_t)tcr;
868    unsigned int size = sizeof(*tcr);
869    ldt_entry_t desc;
870    sel_t sel;
871    int i;
872
873    desc.data.limit00 = (size - 1) & 0xffff;
874    desc.data.limit16 = ((size - 1) >> 16) & 0xf;
875    desc.data.base00 = addr & 0xffff;
876    desc.data.base16 = (addr >> 16) & 0xff;
877    desc.data.base24 = (addr >> 24) & 0xff;
878    desc.data.type = DESC_DATA_WRITE;
879    desc.data.dpl = USER_PRIV;
880    desc.data.present = 1;
881    desc.data.stksz = DESC_CODE_32B;
882    desc.data.granular = DESC_GRAN_BYTE;
883   
884    i = i386_set_ldt(LDT_AUTO_ALLOC, &desc, 1);
885
886    if (i < 0) {
887        perror("i386_set_ldt");
888    } else {
889        sel.index = i;
890        sel.rpl = USER_PRIV;
891        sel.ti = SEL_LDT;
892        tcr->ldt_selector = sel;
893    }
894}
895
896void free_tcr_extra_segment(TCR *tcr)
897{
898  /* load %fs with null segement selector */
899  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
900  if (i386_set_ldt(tcr->ldt_selector.index, NULL, 1) < 0)
901    perror("i386_set_ldt");
902  tcr->ldt_selector = NULL_SEL;
903}
904#endif
905
906#ifdef LINUX
907
908#include <asm/ldt.h>
909#include <sys/syscall.h>
910
911/* see desc_struct in kernel/include/asm-i386/processor.h */
912typedef struct {
913  uint32_t a;
914  uint32_t b;
915} linux_desc_struct;
916
917
918#define desc_avail(d) (((d)->a) == 0)
919
920linux_desc_struct linux_ldt_entries[LDT_ENTRIES];
921
922/* We have to ask the Linux kernel for a copy of the ldt table
923   and manage it ourselves.  It's not clear that this is
924   thread-safe in general, but we can at least ensure that
925   it's thread-safe wrt lisp threads. */
926
927pthread_mutex_t ldt_lock = PTHREAD_MUTEX_INITIALIZER;  /* simple, non-recursive mutex */
928
929int
930modify_ldt(int func, void *ptr, unsigned long bytecount)
931{
932  return syscall(__NR_modify_ldt, func, ptr, bytecount);
933}
934
935
936void
937setup_tcr_extra_segment(TCR *tcr)
938{
939  int i, n;
940  short sel;
941  struct user_desc u = {1, 0, 0, 1, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 1};
942  linux_desc_struct *d = linux_ldt_entries;
943
944  pthread_mutex_lock(&ldt_lock);
945  n = modify_ldt(0,d,LDT_ENTRIES*LDT_ENTRY_SIZE)/LDT_ENTRY_SIZE;
946  for (i = 0; i < n; i++,d++) {
947    if (desc_avail(d)) {
948      break;
949    }
950  }
951  if (i == LDT_ENTRIES) {
952    pthread_mutex_unlock(&ldt_lock);
953    fprintf(stderr, "All 8192 ldt entries in use ?\n");
954    _exit(1);
955  }
956  u.entry_number = i;
957  u.base_addr = (uint32_t)tcr;
958  u.limit = sizeof(TCR);
959  u.limit_in_pages = 0;
960  if (modify_ldt(1,&u,sizeof(struct user_desc)) != 0) {
961    pthread_mutex_unlock(&ldt_lock);
962    fprintf(stderr,"Can't assign LDT entry\n");
963    _exit(1);
964  }
965  sel = (i << 3) | 7;
966  tcr->ldt_selector = sel;
967  pthread_mutex_unlock(&ldt_lock);
968}
969
970void
971free_tcr_extra_segment(TCR *tcr)
972{
973  struct user_desc u = {0, 0, 0, 0, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 0};
974  short sel = tcr->ldt_selector;
975
976  pthread_mutex_lock(&ldt_lock);
977  /* load %fs with null segment selector */
978  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
979  tcr->ldt_selector = 0;
980  u.entry_number = (sel>>3);
981  modify_ldt(1,&u,sizeof(struct user_desc));
982  pthread_mutex_unlock(&ldt_lock);
983 
984}
985
986#endif
987
988#ifdef WINDOWS
989bitvector ldt_entries_in_use = NULL;
990HANDLE ldt_lock;
991
992typedef struct {
993  DWORD offset;
994  DWORD size;
995  LDT_ENTRY entry;
996} win32_ldt_info;
997
998
999int WINAPI (*NtQueryInformationProcess)(HANDLE,DWORD,VOID*,DWORD,DWORD*);
1000int WINAPI (*NtSetInformationProcess)(HANDLE,DWORD,VOID*,DWORD);
1001
1002void
1003init_win32_ldt()
1004{
1005  HANDLE hNtdll;
1006  int status = 0xc0000002;
1007  win32_ldt_info info;
1008  DWORD nret;
1009 
1010
1011  ldt_entries_in_use=malloc(8192/8);
1012  zero_bits(ldt_entries_in_use,8192);
1013  ldt_lock = CreateMutex(NULL,0,NULL);
1014
1015  hNtdll = LoadLibrary("ntdll.dll");
1016  NtQueryInformationProcess = (void*)GetProcAddress(hNtdll, "NtQueryInformationProcess");
1017  NtSetInformationProcess = (void*)GetProcAddress(hNtdll, "NtSetInformationProcess");
1018  if (NtQueryInformationProcess != NULL) {
1019    info.offset = 0;
1020    info.size = sizeof(LDT_ENTRY);
1021    status = NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1022  }
1023
1024  if (status) {
1025    fprintf(stderr, "This application can't run under this OS version\n");
1026    _exit(1);
1027  }
1028}
1029
1030void
1031setup_tcr_extra_segment(TCR *tcr)
1032{
1033  int i, status;
1034  DWORD nret;
1035  win32_ldt_info info;
1036  LDT_ENTRY *entry = &(info.entry);
1037  DWORD *words = (DWORD *)entry, tcraddr = (DWORD)tcr;
1038
1039
1040  WaitForSingleObject(ldt_lock,INFINITE);
1041
1042  for (i = 0; i < 8192; i++) {
1043    if (!ref_bit(ldt_entries_in_use,i)) {
1044      info.offset = i << 3;
1045      info.size = sizeof(LDT_ENTRY);
1046      words[0] = 0;
1047      words[1] = 0;
1048      status = NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1049      if (status == 0) {
1050        if ((info.size == 0) ||
1051            ((words[0] == 0) && (words[1] == 0))) {
1052          break;
1053        }
1054      }
1055    }
1056  }
1057  if (i == 8192) {
1058    ReleaseMutex(ldt_lock);
1059    fprintf(stderr, "All 8192 ldt entries in use ?\n");
1060    _exit(1);
1061  }
1062  set_bit(ldt_entries_in_use,i);
1063  words[0] = 0;
1064  words[1] = 0;
1065  entry->LimitLow = sizeof(TCR);
1066  entry->BaseLow = tcraddr & 0xffff;
1067  entry->HighWord.Bits.BaseMid = (tcraddr >> 16) & 0xff;
1068  entry->HighWord.Bits.BaseHi = (tcraddr >> 24);
1069  entry->HighWord.Bits.Pres = 1;
1070  entry->HighWord.Bits.Default_Big = 1;
1071  entry->HighWord.Bits.Type = 16 | 2; /* read-write data */
1072  entry->HighWord.Bits.Dpl = 3; /* for use by the great unwashed */
1073  info.size = sizeof(LDT_ENTRY);
1074  status = NtSetInformationProcess(GetCurrentProcess(),10,&info,sizeof(info));
1075  if (status != 0) {
1076    ReleaseMutex(ldt_lock);
1077    FBug(NULL, "can't set LDT entry %d, status = 0x%x", i, status);
1078  }
1079#if 1
1080  /* Sanity check */
1081  info.offset = i << 3;
1082  info.size = sizeof(LDT_ENTRY);
1083  words[0] = 0;
1084  words[0] = 0;
1085  NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1086  if (((entry->BaseLow)|((entry->HighWord.Bits.BaseMid)<<16)|((entry->HighWord.Bits.BaseHi)<<24)) != tcraddr) {
1087    Bug(NULL, "you blew it: bad address in ldt entry\n");
1088  }
1089#endif
1090  tcr->ldt_selector = (i << 3) | 7;
1091  ReleaseMutex(ldt_lock);
1092}
1093
1094void 
1095free_tcr_extra_segment(TCR *tcr)
1096{
1097}
1098
1099#endif
1100#ifdef FREEBSD
1101#include <machine/segments.h>
1102#include <machine/sysarch.h>
1103
1104/* It'd be tempting to use i386_set_fsbase() here, but there doesn't
1105   seem to be any way to free the GDT entry it creates. */
1106void
1107setup_tcr_extra_segment(TCR *tcr)
1108{
1109  struct segment_descriptor sd;
1110  uintptr_t addr = (uintptr_t)tcr;
1111  unsigned int size = sizeof(*tcr);
1112  int i;
1113
1114  sd.sd_lolimit = (size - 1) & 0xffff;
1115  sd.sd_hilimit = ((size - 1) >> 16) & 0xf;
1116  sd.sd_lobase = addr & ((1<<24)-1);
1117  sd.sd_type = 18;
1118  sd.sd_dpl = SEL_UPL;
1119  sd.sd_p = 1;
1120  sd.sd_def32 = 1;
1121  sd.sd_gran = 0;
1122
1123  i = i386_set_ldt(LDT_AUTO_ALLOC, (union descriptor *)&sd, 1);
1124
1125  if (i < 0) {
1126    perror("i386_set_ldt");
1127  } else {
1128    tcr->ldt_selector = LSEL(i,SEL_UPL);
1129  }
1130}
1131
1132void 
1133free_tcr_extra_segment(TCR *tcr)
1134{
1135  int idx = tcr->ldt_selector >> 3;
1136  /* load %fs with null segment selector */
1137  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
1138  if (i386_set_ldt(idx, NULL, 1) < 0)
1139    perror("i386_set_ldt");
1140  tcr->ldt_selector = 0;
1141}
1142#endif
1143#endif
1144
1145/*
1146  Caller must hold the area_lock.
1147*/
1148TCR *
1149new_tcr(natural vstack_size, natural tstack_size)
1150{
1151  extern area
1152    *allocate_vstack_holding_area_lock(natural),
1153    *allocate_tstack_holding_area_lock(natural);
1154  area *a;
1155  int i;
1156#ifndef WINDOWS
1157  sigset_t sigmask;
1158
1159  sigemptyset(&sigmask);
1160  pthread_sigmask(SIG_SETMASK,&sigmask, NULL);
1161#endif
1162
1163#ifdef HAVE_TLS
1164  TCR *tcr = &current_tcr;
1165#else /* no TLS */
1166  TCR *tcr = allocate_tcr();
1167#endif
1168
1169#ifdef X86
1170  setup_tcr_extra_segment(tcr);
1171  tcr->linear = tcr;
1172#ifdef X8632
1173  tcr->node_regs_mask = X8632_DEFAULT_NODE_REGS_MASK;
1174#endif
1175#endif
1176
1177#if (WORD_SIZE == 64)
1178  tcr->single_float_convert.tag = subtag_single_float;
1179#endif
1180  lisp_global(TCR_COUNT) += (1<<fixnumshift);
1181  tcr->suspend = new_semaphore(0);
1182  tcr->resume = new_semaphore(0);
1183  tcr->reset_completion = new_semaphore(0);
1184  tcr->activate = new_semaphore(0);
1185  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1186  a = allocate_vstack_holding_area_lock(vstack_size);
1187  tcr->vs_area = a;
1188  a->owner = tcr;
1189  tcr->save_vsp = (LispObj *) a->active; 
1190  a = allocate_tstack_holding_area_lock(tstack_size);
1191  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1192  tcr->ts_area = a;
1193  a->owner = tcr;
1194  tcr->save_tsp = (LispObj *) a->active;
1195#ifdef X86
1196  tcr->next_tsp = tcr->save_tsp;
1197#endif
1198
1199  tcr->valence = TCR_STATE_FOREIGN;
1200#ifdef PPC
1201  tcr->lisp_fpscr.words.l = 0xd0;
1202#endif
1203#ifdef X86
1204  tcr->lisp_mxcsr = (1 << MXCSR_DM_BIT) | 
1205#if 1                           /* Mask underflow; too hard to
1206                                   deal with denorms if underflow is
1207                                   enabled */
1208    (1 << MXCSR_UM_BIT) | 
1209#endif
1210    (1 << MXCSR_PM_BIT);
1211#endif
1212  tcr->save_allocbase = tcr->save_allocptr = (void *) VOID_ALLOCPTR;
1213  tcr->tlb_limit = 2048<<fixnumshift;
1214  tcr->tlb_pointer = (LispObj *)malloc(tcr->tlb_limit);
1215  for (i = 0; i < 2048; i++) {
1216    tcr->tlb_pointer[i] = (LispObj) no_thread_local_binding_marker;
1217  }
1218  TCR_INTERRUPT_LEVEL(tcr) = (LispObj) (-1<<fixnum_shift);
1219#ifndef WINDOWS
1220  tcr->shutdown_count = PTHREAD_DESTRUCTOR_ITERATIONS;
1221#else
1222  tcr->shutdown_count = 1;
1223#endif
1224  return tcr;
1225}
1226
1227void
1228shutdown_thread_tcr(void *arg)
1229{
1230  TCR *tcr = TCR_FROM_TSD(arg),*current=get_tcr(0);
1231
1232  area *vs, *ts, *cs;
1233  void *termination_semaphore;
1234 
1235  if (current == NULL) {
1236    current = tcr;
1237  }
1238
1239  if (--(tcr->shutdown_count) == 0) {
1240    if (tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN)) {
1241      LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
1242        callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
1243   
1244      tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1245      ((void (*)())ptr_from_lispobj(callback_ptr))(1);
1246      tsd_set(lisp_global(TCR_KEY), NULL);
1247    }
1248#ifdef DARWIN
1249    darwin_exception_cleanup(tcr);
1250#endif
1251    LOCK(lisp_global(TCR_AREA_LOCK),current);
1252    vs = tcr->vs_area;
1253    tcr->vs_area = NULL;
1254    ts = tcr->ts_area;
1255    tcr->ts_area = NULL;
1256    cs = tcr->cs_area;
1257    tcr->cs_area = NULL;
1258    if (vs) {
1259      condemn_area_holding_area_lock(vs);
1260    }
1261    if (ts) {
1262      condemn_area_holding_area_lock(ts);
1263    }
1264    if (cs) {
1265      condemn_area_holding_area_lock(cs);
1266    }
1267    destroy_semaphore(&tcr->suspend);
1268    destroy_semaphore(&tcr->resume);
1269    destroy_semaphore(&tcr->reset_completion);
1270    destroy_semaphore(&tcr->activate);
1271    tcr->tlb_limit = 0;
1272    free(tcr->tlb_pointer);
1273    tcr->tlb_pointer = NULL;
1274    tcr->osid = 0;
1275    tcr->interrupt_pending = 0;
1276    termination_semaphore = tcr->termination_semaphore;
1277    tcr->termination_semaphore = NULL;
1278#ifdef HAVE_TLS
1279    dequeue_tcr(tcr);
1280#endif
1281#ifdef X8632
1282    free_tcr_extra_segment(tcr);
1283#endif
1284#ifdef WIN32
1285    CloseHandle((HANDLE)tcr->io_datum);
1286    tcr->io_datum = NULL;
1287    free(tcr->native_thread_info);
1288    tcr->native_thread_info = NULL;
1289#endif
1290    UNLOCK(lisp_global(TCR_AREA_LOCK),current);
1291    if (termination_semaphore) {
1292      SEM_RAISE(termination_semaphore);
1293    }
1294  } else {
1295    tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1296  }
1297}
1298
1299void
1300tcr_cleanup(void *arg)
1301{
1302  TCR *tcr = (TCR *)arg;
1303  area *a;
1304
1305  a = tcr->vs_area;
1306  if (a) {
1307    a->active = a->high;
1308  }
1309  a = tcr->ts_area;
1310  if (a) {
1311    a->active = a->high;
1312  }
1313  a = tcr->cs_area;
1314  if (a) {
1315    a->active = a->high;
1316  }
1317  tcr->valence = TCR_STATE_FOREIGN;
1318  tcr->shutdown_count = 1;
1319  shutdown_thread_tcr(tcr);
1320  tsd_set(lisp_global(TCR_KEY), NULL);
1321}
1322
1323void *
1324current_native_thread_id()
1325{
1326  return ((void *) (natural)
1327#ifdef LINUX
1328#ifdef __NR_gettid
1329          syscall(__NR_gettid)
1330#else
1331          getpid()
1332#endif
1333#endif
1334#ifdef DARWIN
1335          mach_thread_self()
1336#endif
1337#ifdef FREEBSD
1338          pthread_self()
1339#endif
1340#ifdef SOLARIS
1341          pthread_self()
1342#endif
1343#ifdef WINDOWS
1344          GetCurrentThreadId()
1345#endif
1346          );
1347}
1348
1349
1350void
1351thread_init_tcr(TCR *tcr, void *stack_base, natural stack_size)
1352{
1353  area *a, *register_cstack_holding_area_lock(BytePtr, natural);
1354
1355  tcr->osid = current_thread_osid();
1356  tcr->native_thread_id = current_native_thread_id();
1357  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1358  a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size);
1359  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1360  tcr->cs_area = a;
1361  a->owner = tcr;
1362  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
1363    tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
1364  }
1365#ifdef LINUX
1366#ifdef PPC
1367#ifndef PPC64
1368  tcr->native_thread_info = current_r2;
1369#endif
1370#endif
1371#endif
1372  tcr->errno_loc = &errno;
1373  tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1374#ifdef DARWIN
1375  extern Boolean use_mach_exception_handling;
1376  if (use_mach_exception_handling) {
1377    darwin_exception_init(tcr);
1378  }
1379#endif
1380#ifdef LINUX
1381  linux_exception_init(tcr);
1382#endif
1383#ifdef WINDOWS
1384  tcr->io_datum = (VOID *)CreateEvent(NULL, true, false, NULL);
1385  tcr->native_thread_info = malloc(sizeof(CONTEXT));
1386#endif
1387  tcr->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
1388}
1389
1390/*
1391  Register the specified tcr as "belonging to" the current thread.
1392  Under Darwin, setup Mach exception handling for the thread.
1393  Install cleanup handlers for thread termination.
1394*/
1395void
1396register_thread_tcr(TCR *tcr)
1397{
1398  void *stack_base = NULL;
1399  natural stack_size = 0;
1400
1401  os_get_current_thread_stack_bounds(&stack_base, &stack_size);
1402  thread_init_tcr(tcr, stack_base, stack_size);
1403  enqueue_tcr(tcr);
1404}
1405
1406
1407 
1408 
1409#ifndef MAP_GROWSDOWN
1410#define MAP_GROWSDOWN 0
1411#endif
1412
1413Ptr
1414create_stack(natural size)
1415{
1416  Ptr p;
1417  size=align_to_power_of_2(size, log2_page_size);
1418  p = (Ptr) MapMemoryForStack((size_t)size);
1419  if (p != (Ptr)(-1)) {
1420    *((size_t *)p) = size;
1421    return p;
1422  }
1423  allocation_failure(true, size);
1424
1425}
1426
1427void *
1428allocate_stack(natural size)
1429{
1430  return create_stack(size);
1431}
1432
1433void
1434free_stack(void *s)
1435{
1436  size_t size = *((size_t *)s);
1437  UnMapMemory(s, size);
1438}
1439
1440Boolean threads_initialized = false;
1441
1442#ifndef USE_FUTEX
1443#ifdef WINDOWS
1444void
1445count_cpus()
1446{
1447  SYSTEM_INFO si;
1448
1449  GetSystemInfo(&si);
1450  if (si.dwNumberOfProcessors > 1) {
1451    spin_lock_tries = 1024;
1452  }
1453}
1454#else
1455void
1456count_cpus()
1457{
1458#ifdef DARWIN
1459  /* As of OSX 10.4, Darwin doesn't define _SC_NPROCESSORS_ONLN */
1460#include <mach/host_info.h>
1461
1462  struct host_basic_info info;
1463  mach_msg_type_number_t count = HOST_BASIC_INFO_COUNT;
1464 
1465  if (KERN_SUCCESS == host_info(mach_host_self(), HOST_BASIC_INFO,(host_info_t)(&info),&count)) {
1466    if (info.max_cpus > 1) {
1467      spin_lock_tries = 1024;
1468    }
1469  }
1470#else
1471  int n = sysconf(_SC_NPROCESSORS_ONLN);
1472 
1473  if (n > 1) {
1474    spin_lock_tries = 1024;
1475  }
1476#endif
1477}
1478#endif
1479#endif
1480
1481void
1482init_threads(void * stack_base, TCR *tcr)
1483{
1484  lisp_global(INITIAL_TCR) = (LispObj)ptr_to_lispobj(tcr);
1485#ifdef WINDOWS
1486  lisp_global(TCR_KEY) = TlsAlloc();
1487  pCancelIoEx = windows_find_symbol(NULL, "CancelIoEx");
1488#else
1489  pthread_key_create((pthread_key_t *)&(lisp_global(TCR_KEY)), shutdown_thread_tcr);
1490  thread_signal_setup();
1491#endif
1492 
1493#ifndef USE_FUTEX
1494  count_cpus();
1495#endif
1496  threads_initialized = true;
1497}
1498
1499
1500#ifdef WINDOWS
1501unsigned CALLBACK
1502#else
1503void *
1504#endif
1505lisp_thread_entry(void *param)
1506{
1507  thread_activation *activation = (thread_activation *)param;
1508  TCR *tcr = new_tcr(activation->vsize, activation->tsize);
1509#ifndef WINDOWS
1510  sigset_t mask, old_mask;
1511
1512  sigemptyset(&mask);
1513  pthread_sigmask(SIG_SETMASK, &mask, &old_mask);
1514#endif
1515
1516  register_thread_tcr(tcr);
1517
1518#ifndef WINDOWS
1519  pthread_cleanup_push(tcr_cleanup,(void *)tcr);
1520#endif
1521  tcr->vs_area->active -= node_size;
1522  *(--tcr->save_vsp) = lisp_nil;
1523  enable_fp_exceptions();
1524  SET_TCR_FLAG(tcr,TCR_FLAG_BIT_AWAITING_PRESET);
1525  activation->tcr = tcr;
1526  SEM_RAISE(activation->created);
1527  do {
1528    SEM_RAISE(tcr->reset_completion);
1529    SEM_WAIT_FOREVER(tcr->activate);
1530    /* Now go run some lisp code */
1531    start_lisp(TCR_TO_TSD(tcr),0);
1532  } while (tcr->flags & (1<<TCR_FLAG_BIT_AWAITING_PRESET));
1533#ifndef WINDOWS
1534  pthread_cleanup_pop(true);
1535#else
1536  tcr_cleanup(tcr);
1537#endif
1538#ifdef WINDOWS
1539  return 0;
1540#else
1541  return NULL;
1542#endif
1543}
1544
1545void *
1546xNewThread(natural control_stack_size,
1547           natural value_stack_size,
1548           natural temp_stack_size)
1549
1550{
1551  thread_activation activation;
1552
1553
1554  activation.tsize = temp_stack_size;
1555  activation.vsize = value_stack_size;
1556  activation.tcr = 0;
1557  activation.created = new_semaphore(0);
1558  if (create_system_thread(control_stack_size +(CSTACK_HARDPROT+CSTACK_SOFTPROT), 
1559                           NULL, 
1560                           lisp_thread_entry,
1561                           (void *) &activation)) {
1562   
1563    SEM_WAIT_FOREVER(activation.created);       /* Wait until thread's entered its initial function */
1564  }
1565  destroy_semaphore(&activation.created); 
1566  return TCR_TO_TSD(activation.tcr);
1567}
1568
1569Boolean
1570active_tcr_p(TCR *q)
1571{
1572  TCR *head = (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR)), *p = head;
1573 
1574  do {
1575    if (p == q) {
1576      return true;
1577    }
1578    p = p->next;
1579  } while (p != head);
1580  return false;
1581}
1582
1583#ifdef WINDOWS
1584OSErr
1585xDisposeThread(TCR *tcr)
1586{
1587  return 0;                     /* I don't think that this is ever called. */
1588}
1589#else
1590OSErr
1591xDisposeThread(TCR *tcr)
1592{
1593  if (tcr != (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR))) {
1594    if (active_tcr_p(tcr) && (tcr != get_tcr(false))) {
1595      pthread_cancel((pthread_t)(tcr->osid));
1596      return 0;
1597    }
1598  }
1599  return -50;
1600}
1601#endif
1602
1603OSErr
1604xYieldToThread(TCR *target)
1605{
1606  Bug(NULL, "xYieldToThread ?");
1607  return 0;
1608}
1609 
1610OSErr
1611xThreadCurrentStackSpace(TCR *tcr, unsigned *resultP)
1612{
1613  Bug(NULL, "xThreadCurrentStackSpace ?");
1614  return 0;
1615}
1616
1617
1618#ifdef WINDOWS
1619LispObj
1620create_system_thread(size_t stack_size,
1621                     void* stackaddr,
1622                     unsigned CALLBACK (*start_routine)(void *),
1623                     void* param)
1624{
1625  HANDLE thread_handle;
1626
1627  stack_size = ((stack_size+(((1<<16)-1)))&~((1<<16)-1));
1628
1629  thread_handle = (HANDLE)_beginthreadex(NULL, 
1630                                         0/*stack_size*/,
1631                                         start_routine,
1632                                         param,
1633                                         0, 
1634                                         NULL);
1635
1636  if (thread_handle == NULL) {
1637    wperror("CreateThread");
1638  }
1639  return (LispObj) ptr_to_lispobj(thread_handle);
1640}
1641#else
1642LispObj
1643create_system_thread(size_t stack_size,
1644                     void* stackaddr,
1645                     void* (*start_routine)(void *),
1646                     void* param)
1647{
1648  pthread_attr_t attr;
1649  pthread_t returned_thread = (pthread_t) 0;
1650
1651  pthread_attr_init(&attr);
1652  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); 
1653
1654  if (stack_size == MINIMAL_THREAD_STACK_SIZE) {
1655    stack_size = PTHREAD_STACK_MIN;
1656  }
1657
1658  stack_size = ensure_stack_limit(stack_size);
1659  if (stackaddr != NULL) {
1660    /* Size must have been specified.  Sort of makes sense ... */
1661#ifdef DARWIN
1662    Fatal("no pthread_attr_setsetstack. "," Which end of stack does address refer to?");
1663#else
1664    pthread_attr_setstack(&attr, stackaddr, stack_size);
1665#endif
1666  } else if (stack_size != DEFAULT_THREAD_STACK_SIZE) {
1667    pthread_attr_setstacksize(&attr,stack_size);
1668  }
1669
1670  /*
1671     I think that's just about enough ... create the thread.
1672  */
1673  pthread_create(&returned_thread, &attr, start_routine, param);
1674  pthread_attr_destroy(&attr);
1675  return (LispObj) ptr_to_lispobj(returned_thread);
1676}
1677#endif
1678
1679TCR *
1680get_tcr(Boolean create)
1681{
1682#ifdef HAVE_TLS
1683  TCR *current = current_tcr.linear;
1684#else
1685  void *tsd = (void *)tsd_get(lisp_global(TCR_KEY));
1686  TCR *current = (tsd == NULL) ? NULL : TCR_FROM_TSD(tsd);
1687#endif
1688
1689  if ((current == NULL) && create) {
1690    LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
1691      callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
1692    int i, nbindwords = 0;
1693    extern unsigned initial_stack_size;
1694   
1695    /* Make one. */
1696    current = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
1697    SET_TCR_FLAG(current,TCR_FLAG_BIT_FOREIGN);
1698    register_thread_tcr(current);
1699#ifdef DEBUG_TCR_CREATION
1700#ifndef WINDOWS
1701    fprintf(stderr, "\ncreating TCR for pthread 0x%x", pthread_self());
1702#endif
1703#endif
1704    current->vs_area->active -= node_size;
1705    *(--current->save_vsp) = lisp_nil;
1706#ifdef PPC
1707#define NSAVEREGS 8
1708#endif
1709#ifdef X8664
1710#define NSAVEREGS 4
1711#endif
1712#ifdef X8632
1713#define NSAVEREGS 0
1714#endif
1715    for (i = 0; i < NSAVEREGS; i++) {
1716      *(--current->save_vsp) = 0;
1717      current->vs_area->active -= node_size;
1718    }
1719    nbindwords = ((int (*)())ptr_from_lispobj(callback_ptr))(-1);
1720    for (i = 0; i < nbindwords; i++) {
1721      *(--current->save_vsp) = 0;
1722      current->vs_area->active -= node_size;
1723    }
1724    current->shutdown_count = 1;
1725    ((void (*)())ptr_from_lispobj(callback_ptr))(0);
1726
1727  }
1728 
1729  return current;
1730}
1731
1732#ifdef WINDOWS
1733
1734Boolean
1735suspend_tcr(TCR *tcr)
1736{
1737  int suspend_count = atomic_incf(&(tcr->suspend_count));
1738  DWORD rc;
1739  if (suspend_count == 1) {
1740    CONTEXT  *pcontext = (CONTEXT *)tcr->native_thread_info;
1741    HANDLE hthread = (HANDLE)(tcr->osid);
1742    pc where;
1743    area *cs = tcr->cs_area;
1744    LispObj foreign_rsp;
1745
1746    if (hthread == NULL) {
1747      return false;
1748    }
1749    rc = SuspendThread(hthread);
1750    if (rc == -1) {
1751      /* If the thread's simply dead, we should handle that here */
1752      return false;
1753    }
1754    pcontext->ContextFlags = CONTEXT_ALL;
1755    rc = GetThreadContext(hthread, pcontext);
1756    if (rc == 0) {
1757      return false;
1758    }
1759    where = (pc)(xpPC(pcontext));
1760
1761    if (tcr->valence == TCR_STATE_LISP) {
1762      if ((where >= restore_windows_context_start) &&
1763          (where < restore_windows_context_end)) {
1764        /* Thread has started to return from an exception. */
1765        if (where < restore_windows_context_load_rcx) {
1766          /* In the process of restoring registers; context still in
1767             %rcx.  Just make our suspend_context be the context
1768             we're trying to restore, so that we'll resume from
1769             the suspend in the same context that we're trying to
1770             restore */
1771#ifdef WIN_64
1772          *pcontext = * (CONTEXT *)(pcontext->Rcx);
1773#else
1774          fprintf(stderr, "missing win32 suspend code, case (1)\n");
1775#endif
1776        } else {
1777          /* Most of the context has already been restored; fix %rcx
1778             if need be, then restore ss:rsp, cs:rip, and flags. */
1779#ifdef WIN64
1780          x64_iret_frame *iret_frame = (x64_iret_frame *) (pcontext->Rsp);
1781          if (where == restore_windows_context_load_rcx) {
1782            pcontext->Rcx = ((CONTEXT*)(pcontext->Rcx))->Rcx;
1783          }
1784          pcontext->Rip = iret_frame->Rip;
1785          pcontext->SegCs = (WORD) iret_frame->Cs;
1786          pcontext->EFlags = (DWORD) iret_frame->Rflags;
1787          pcontext->Rsp = iret_frame->Rsp;
1788          pcontext->SegSs = (WORD) iret_frame->Ss;
1789#else
1790#warning need context setup for win32
1791          fprintf(stderr, "missing win32 suspend code, case (2)\n");
1792#endif
1793        }
1794        tcr->suspend_context = NULL;
1795      } else {
1796        area *ts = tcr->ts_area;
1797        /* If we're in the lisp heap, or in x86-spentry??.o, or in
1798           x86-subprims??.o, or in the subprims jump table at #x15000,
1799           or on the tstack ... we're just executing lisp code.  Otherwise,
1800           we got an exception while executing lisp code, but haven't
1801           entered the handler yet (still in Windows exception glue
1802           or switching stacks or something.)  In the latter case, we
1803           basically want to get to he handler and have it notice
1804           the pending exception request, and suspend the thread at that
1805           point. */
1806        if (!((where < (pc)lisp_global(HEAP_END)) &&
1807              (where >= (pc)lisp_global(HEAP_START))) &&
1808            !((where < spentry_end) && (where >= spentry_start)) &&
1809            !((where < subprims_end) && (where >= subprims_start)) &&
1810            !((where < (pc) 0x16000) &&
1811              (where >= (pc) 0x15000)) &&
1812            !((where < (pc) (ts->high)) &&
1813              (where >= (pc) (ts->low)))) {
1814          /* The thread has lisp valence, but is not executing code
1815             where we expect lisp code to be and is not exiting from
1816             an exception handler.  That pretty much means that it's
1817             on its way into an exception handler; we have to handshake
1818             until it enters an exception-wait state. */
1819          /* There are likely race conditions here */
1820          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
1821          ResumeThread(hthread);
1822          SEM_WAIT_FOREVER(tcr->suspend);
1823          SuspendThread(hthread);
1824          /* The thread is either waiting for its resume semaphore to
1825             be signaled or is about to wait.  Signal it now, while
1826             the thread's suspended. */
1827          SEM_RAISE(tcr->resume);
1828          pcontext->ContextFlags = CONTEXT_ALL;
1829          GetThreadContext(hthread, pcontext);
1830        }
1831      }
1832    } else {
1833      if (tcr->valence == TCR_STATE_EXCEPTION_RETURN) {
1834        if (!tcr->pending_exception_context) {
1835          FBug(pcontext, "we're confused here.");
1836        }
1837        *pcontext = *tcr->pending_exception_context;
1838        tcr->pending_exception_context = NULL;
1839        tcr->valence = TCR_STATE_LISP;
1840      }
1841    }
1842    tcr->suspend_context = pcontext;
1843    return true;
1844  }
1845  return false;
1846}
1847#else
1848Boolean
1849suspend_tcr(TCR *tcr)
1850{
1851  int suspend_count = atomic_incf(&(tcr->suspend_count));
1852  pthread_t thread;
1853  if (suspend_count == 1) {
1854    thread = (pthread_t)(tcr->osid);
1855    if ((thread != (pthread_t) 0) &&
1856        (pthread_kill(thread, thread_suspend_signal) == 0)) {
1857      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1858    } else {
1859      /* A problem using pthread_kill.  On Darwin, this can happen
1860         if the thread has had its signal mask surgically removed
1861         by pthread_exit.  If the native (Mach) thread can be suspended,
1862         do that and return true; otherwise, flag the tcr as belonging
1863         to a dead thread by setting tcr->osid to 0.
1864      */
1865      tcr->osid = 0;
1866      return false;
1867    }
1868    return true;
1869  }
1870  return false;
1871}
1872#endif
1873
1874#ifdef WINDOWS
1875Boolean
1876tcr_suspend_ack(TCR *tcr)
1877{
1878  return true;
1879}
1880#else
1881Boolean
1882tcr_suspend_ack(TCR *tcr)
1883{
1884  if (tcr->flags & (1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING)) {
1885    SEM_WAIT_FOREVER(tcr->suspend);
1886    tcr->flags &= ~(1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1887  }
1888  return true;
1889}
1890#endif
1891     
1892
1893Boolean
1894kill_tcr(TCR *tcr)
1895{
1896  TCR *current = get_tcr(true);
1897  Boolean result = false;
1898
1899  LOCK(lisp_global(TCR_AREA_LOCK),current);
1900  {
1901    LispObj osid = tcr->osid;
1902   
1903    if (osid) {
1904      result = true;
1905#ifdef WINDOWS
1906      /* What we really want to de hear is (something like)
1907         forcing the thread to run quit_handler().  For now,
1908         mark the TCR as dead and kill thw Windows thread. */
1909      tcr->osid = 0;
1910      if (!TerminateThread((HANDLE)osid, 0)) {
1911        result = false;
1912      } else {
1913        shutdown_thread_tcr(tcr);
1914      }
1915#else
1916      if (pthread_kill((pthread_t)osid,SIGQUIT)) {
1917        result = false;
1918      }
1919#endif
1920    }
1921  }
1922  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
1923  return result;
1924}
1925
1926Boolean
1927lisp_suspend_tcr(TCR *tcr)
1928{
1929  Boolean suspended;
1930  TCR *current = get_tcr(true);
1931 
1932  LOCK(lisp_global(TCR_AREA_LOCK),current);
1933  suspended = suspend_tcr(tcr);
1934  if (suspended) {
1935    while (!tcr_suspend_ack(tcr));
1936  }
1937  UNLOCK(lisp_global(TCR_AREA_LOCK),current);
1938  return suspended;
1939}
1940         
1941#ifdef WINDOWS
1942Boolean
1943resume_tcr(TCR *tcr)
1944{
1945  int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
1946  DWORD rc;
1947  if (suspend_count == 0) {
1948    CONTEXT *context = tcr->suspend_context;
1949    HANDLE hthread = (HANDLE)(tcr->osid);
1950
1951    if (context) {
1952      context->ContextFlags = CONTEXT_ALL;
1953      tcr->suspend_context = NULL;
1954      SetThreadContext(hthread,context);
1955      rc = ResumeThread(hthread);
1956      if (rc == -1) {
1957        wperror("ResumeThread");
1958        return false;
1959      }
1960      return true;
1961    }
1962  }
1963  return false;
1964}   
1965#else
1966Boolean
1967resume_tcr(TCR *tcr)
1968{
1969  int suspend_count = atomic_decf(&(tcr->suspend_count));
1970  if (suspend_count == 0) {
1971    void *s = (tcr->resume);
1972    if (s != NULL) {
1973      SEM_RAISE(s);
1974      return true;
1975    }
1976  }
1977  return false;
1978}
1979#endif
1980
1981   
1982
1983
1984Boolean
1985lisp_resume_tcr(TCR *tcr)
1986{
1987  Boolean resumed;
1988  TCR *current = get_tcr(true);
1989 
1990  LOCK(lisp_global(TCR_AREA_LOCK),current);
1991  resumed = resume_tcr(tcr);
1992  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
1993  return resumed;
1994}
1995
1996
1997TCR *freed_tcrs = NULL;
1998
1999void
2000enqueue_freed_tcr (TCR *tcr)
2001{
2002#ifndef HAVE_TLS
2003  tcr->next = freed_tcrs;
2004  freed_tcrs = tcr;
2005#endif
2006}
2007
2008/* It's not clear that we can safely condemn a dead tcr's areas, since
2009   we may not be able to call free() if a suspended thread owns a
2010   malloc lock. At least make the areas appear to be empty.
2011*/
2012   
2013
2014void
2015normalize_dead_tcr_areas(TCR *tcr)
2016{
2017  area *a;
2018
2019  a = tcr->vs_area;
2020  if (a) {
2021    a->active = a->high;
2022  }
2023
2024  a = tcr->ts_area;
2025  if (a) {
2026    a->active = a->high;
2027  }
2028
2029  a = tcr->cs_area;
2030  if (a) {
2031    a->active = a->high;
2032  }
2033}
2034   
2035void
2036free_freed_tcrs ()
2037{
2038  TCR *current, *next;
2039
2040  for (current = freed_tcrs; current; current = next) {
2041    next = current->next;
2042#ifndef HAVE_TLS
2043#ifdef WIN32
2044    free(current->allocated);
2045#else
2046    free(current);
2047#endif
2048#endif
2049  }
2050  freed_tcrs = NULL;
2051}
2052
2053void
2054suspend_other_threads(Boolean for_gc)
2055{
2056  TCR *current = get_tcr(true), *other, *next;
2057  int dead_tcr_count = 0;
2058  Boolean all_acked;
2059
2060  LOCK(lisp_global(TCR_AREA_LOCK), current);
2061  for (other = current->next; other != current; other = other->next) {
2062    if ((other->osid != 0)) {
2063      suspend_tcr(other);
2064      if (other->osid == 0) {
2065        dead_tcr_count++;
2066      }
2067    } else {
2068      dead_tcr_count++;
2069    }
2070  }
2071
2072  do {
2073    all_acked = true;
2074    for (other = current->next; other != current; other = other->next) {
2075      if ((other->osid != 0)) {
2076        if (!tcr_suspend_ack(other)) {
2077          all_acked = false;
2078        }
2079      }
2080    }
2081  } while(! all_acked);
2082
2083     
2084
2085  /* All other threads are suspended; can safely delete dead tcrs now */
2086  if (dead_tcr_count) {
2087    for (other = current->next; other != current; other = next) {
2088      next = other->next;
2089      if ((other->osid == 0))  {
2090        normalize_dead_tcr_areas(other);
2091        dequeue_tcr(other);
2092        enqueue_freed_tcr(other);
2093      }
2094    }
2095  }
2096}
2097
2098void
2099lisp_suspend_other_threads()
2100{
2101  suspend_other_threads(false);
2102}
2103
2104void
2105resume_other_threads(Boolean for_gc)
2106{
2107  TCR *current = get_tcr(true), *other;
2108  for (other = current->next; other != current; other = other->next) {
2109    if ((other->osid != 0)) {
2110      resume_tcr(other);
2111    }
2112  }
2113  free_freed_tcrs();
2114  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
2115}
2116
2117void
2118lisp_resume_other_threads()
2119{
2120  resume_other_threads(false);
2121}
2122
2123
2124
2125rwlock *
2126rwlock_new()
2127{
2128  extern int cache_block_size;
2129
2130  void *p = calloc(1,sizeof(rwlock)+cache_block_size-1);
2131  rwlock *rw = NULL;;
2132 
2133  if (p) {
2134    rw = (rwlock *) ((((natural)p)+cache_block_size-1) & (~(cache_block_size-1)));
2135    rw->malloced_ptr = p;
2136#ifndef USE_FUTEX
2137    rw->reader_signal = new_semaphore(0);
2138    rw->writer_signal = new_semaphore(0);
2139    if ((rw->reader_signal == NULL) || (rw->writer_signal == NULL)) {
2140      if (rw->reader_signal) {
2141        destroy_semaphore(&(rw->reader_signal));
2142      } else {
2143        destroy_semaphore(&(rw->writer_signal));
2144      }
2145      free(rw);
2146      rw = NULL;
2147    }
2148#endif
2149  }
2150  return rw;
2151}
2152
2153     
2154/*
2155  Try to get read access to a multiple-readers/single-writer lock.  If
2156  we already have read access, return success (indicating that the
2157  lock is held another time.  If we already have write access to the
2158  lock ... that won't work; return EDEADLK.  Wait until no other
2159  thread has or is waiting for write access, then indicate that we
2160  hold read access once.
2161*/
2162#ifndef USE_FUTEX
2163int
2164rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2165{
2166  int err = 0;
2167 
2168  LOCK_SPINLOCK(rw->spin, tcr);
2169
2170  if (rw->writer == tcr) {
2171    RELEASE_SPINLOCK(rw->spin);
2172    return EDEADLK;
2173  }
2174
2175  while (rw->blocked_writers || (rw->state > 0)) {
2176    rw->blocked_readers++;
2177    RELEASE_SPINLOCK(rw->spin);
2178    err = semaphore_maybe_timedwait(rw->reader_signal,waitfor);
2179    LOCK_SPINLOCK(rw->spin,tcr);
2180    rw->blocked_readers--;
2181    if (err == EINTR) {
2182      err = 0;
2183    }
2184    if (err) {
2185      RELEASE_SPINLOCK(rw->spin);
2186      return err;
2187    }
2188  }
2189  rw->state--;
2190  RELEASE_SPINLOCK(rw->spin);
2191  return err;
2192}
2193#else
2194int
2195rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2196{
2197  natural waitval;
2198
2199  lock_futex(&rw->spin);
2200
2201  if (rw->writer == tcr) {
2202    unlock_futex(&rw->spin);
2203    return EDEADLOCK;
2204  }
2205  while (1) {
2206    if (rw->writer == NULL) {
2207      --rw->state;
2208      unlock_futex(&rw->spin);
2209      return 0;
2210    }
2211    rw->blocked_readers++;
2212    waitval = rw->reader_signal;
2213    unlock_futex(&rw->spin);
2214    futex_wait(&rw->reader_signal,waitval);
2215    lock_futex(&rw->spin);
2216    rw->blocked_readers--;
2217  }
2218  return 0;
2219}
2220#endif   
2221
2222
2223/*
2224  Try to obtain write access to the lock.
2225  It is an error if we already have read access, but it's hard to
2226  detect that.
2227  If we already have write access, increment the count that indicates
2228  that.
2229  Otherwise, wait until the lock is not held for reading or writing,
2230  then assert write access.
2231*/
2232
2233#ifndef USE_FUTEX
2234int
2235rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2236{
2237  int err = 0;
2238
2239  LOCK_SPINLOCK(rw->spin,tcr);
2240  if (rw->writer == tcr) {
2241    rw->state++;
2242    RELEASE_SPINLOCK(rw->spin);
2243    return 0;
2244  }
2245
2246  while (rw->state != 0) {
2247    rw->blocked_writers++;
2248    RELEASE_SPINLOCK(rw->spin);
2249    err = semaphore_maybe_timedwait(rw->writer_signal, waitfor);
2250    LOCK_SPINLOCK(rw->spin,tcr);
2251    rw->blocked_writers--;
2252    if (err == EINTR) {
2253      err = 0;
2254    }
2255    if (err) {
2256      RELEASE_SPINLOCK(rw->spin);
2257      return err;
2258    }
2259  }
2260  rw->state = 1;
2261  rw->writer = tcr;
2262  RELEASE_SPINLOCK(rw->spin);
2263  return err;
2264}
2265
2266#else
2267int
2268rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2269{
2270  int err = 0;
2271  natural waitval;
2272
2273  lock_futex(&rw->spin);
2274  if (rw->writer == tcr) {
2275    rw->state++;
2276    unlock_futex(&rw->spin);
2277    return 0;
2278  }
2279
2280  while (rw->state != 0) {
2281    rw->blocked_writers++;
2282    waitval = rw->writer_signal;
2283    unlock_futex(&rw->spin);
2284    futex_wait(&rw->writer_signal,waitval);
2285    lock_futex(&rw->spin);
2286    rw->blocked_writers--;
2287  }
2288  rw->state = 1;
2289  rw->writer = tcr;
2290  unlock_futex(&rw->spin);
2291  return err;
2292}
2293#endif
2294
2295/*
2296  Sort of the same as above, only return EBUSY if we'd have to wait.
2297*/
2298#ifndef USE_FUTEX
2299int
2300rwlock_try_wlock(rwlock *rw, TCR *tcr)
2301{
2302  int ret = EBUSY;
2303
2304  LOCK_SPINLOCK(rw->spin,tcr);
2305  if (rw->writer == tcr) {
2306    rw->state++;
2307    ret = 0;
2308  } else {
2309    if (rw->state == 0) {
2310      rw->writer = tcr;
2311      rw->state = 1;
2312      ret = 0;
2313    }
2314  }
2315  RELEASE_SPINLOCK(rw->spin);
2316  return ret;
2317}
2318#else
2319int
2320rwlock_try_wlock(rwlock *rw, TCR *tcr)
2321{
2322  int ret = EBUSY;
2323
2324  lock_futex(&rw->spin);
2325  if (rw->writer == tcr) {
2326    rw->state++;
2327    ret = 0;
2328  } else {
2329    if (rw->state == 0) {
2330      rw->writer = tcr;
2331      rw->state = 1;
2332      ret = 0;
2333    }
2334  }
2335  unlock_futex(&rw->spin);
2336  return ret;
2337}
2338#endif
2339
2340#ifndef USE_FUTEX
2341int
2342rwlock_try_rlock(rwlock *rw, TCR *tcr)
2343{
2344  int ret = EBUSY;
2345
2346  LOCK_SPINLOCK(rw->spin,tcr);
2347  if (rw->state <= 0) {
2348    --rw->state;
2349    ret = 0;
2350  }
2351  RELEASE_SPINLOCK(rw->spin);
2352  return ret;
2353}
2354#else
2355int
2356rwlock_try_rlock(rwlock *rw, TCR *tcr)
2357{
2358  int ret = EBUSY;
2359
2360  lock_futex(&rw->spin);
2361  if (rw->state <= 0) {
2362    --rw->state;
2363    ret = 0;
2364  }
2365  unlock_futex(&rw->spin);
2366  return ret;
2367}
2368#endif
2369
2370
2371
2372#ifndef USE_FUTEX
2373int
2374rwlock_unlock(rwlock *rw, TCR *tcr)
2375{
2376
2377  int err = 0;
2378  natural blocked_readers = 0;
2379
2380  LOCK_SPINLOCK(rw->spin,tcr);
2381  if (rw->state > 0) {
2382    if (rw->writer != tcr) {
2383      err = EINVAL;
2384    } else {
2385      --rw->state;
2386      if (rw->state == 0) {
2387        rw->writer = NULL;
2388      }
2389    }
2390  } else {
2391    if (rw->state < 0) {
2392      ++rw->state;
2393    } else {
2394      err = EINVAL;
2395    }
2396  }
2397  if (err) {
2398    RELEASE_SPINLOCK(rw->spin);
2399    return err;
2400  }
2401 
2402  if (rw->state == 0) {
2403    if (rw->blocked_writers) {
2404      SEM_RAISE(rw->writer_signal);
2405    } else {
2406      blocked_readers = rw->blocked_readers;
2407      if (blocked_readers) {
2408        SEM_BROADCAST(rw->reader_signal, blocked_readers);
2409      }
2410    }
2411  }
2412  RELEASE_SPINLOCK(rw->spin);
2413  return 0;
2414}
2415#else
2416int
2417rwlock_unlock(rwlock *rw, TCR *tcr)
2418{
2419
2420  int err = 0;
2421
2422  lock_futex(&rw->spin);
2423  if (rw->state > 0) {
2424    if (rw->writer != tcr) {
2425      err = EINVAL;
2426    } else {
2427      --rw->state;
2428      if (rw->state == 0) {
2429        rw->writer = NULL;
2430      }
2431    }
2432  } else {
2433    if (rw->state < 0) {
2434      ++rw->state;
2435    } else {
2436      err = EINVAL;
2437    }
2438  }
2439  if (err) {
2440    unlock_futex(&rw->spin);
2441    return err;
2442  }
2443 
2444  if (rw->state == 0) {
2445    if (rw->blocked_writers) {
2446      ++rw->writer_signal;
2447      unlock_futex(&rw->spin);
2448      futex_wake(&rw->writer_signal,1);
2449      return 0;
2450    }
2451    if (rw->blocked_readers) {
2452      ++rw->reader_signal;
2453      unlock_futex(&rw->spin);
2454      futex_wake(&rw->reader_signal, INT_MAX);
2455      return 0;
2456    }
2457  }
2458  unlock_futex(&rw->spin);
2459  return 0;
2460}
2461#endif
2462
2463       
2464void
2465rwlock_destroy(rwlock *rw)
2466{
2467#ifndef USE_FUTEX
2468  destroy_semaphore((void **)&rw->reader_signal);
2469  destroy_semaphore((void **)&rw->writer_signal);
2470#endif
2471  postGCfree((void *)(rw->malloced_ptr));
2472}
2473
2474
2475
Note: See TracBrowser for help on using the repository browser.