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

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

In Windows raise_thread_interrupt, setup call to interrupt_handler for
Win32.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 51.5 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->foreign_exception_status);
106      if (pCancelIoEx) {
107        pCancelIoEx(pending->h, pending->o);
108      } else {
109        CancelIo(pending->h);
110      }
111    } else {
112      QueueUserAPC(nullAPC, hthread, 0);
113    }
114
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#ifdef DARWIN
860#include <architecture/i386/table.h>
861#include <architecture/i386/sel.h>
862#include <i386/user_ldt.h>
863
864void setup_tcr_extra_segment(TCR *tcr)
865{
866    uintptr_t addr = (uintptr_t)tcr;
867    unsigned int size = sizeof(*tcr);
868    ldt_entry_t desc;
869    sel_t sel;
870    int i;
871
872    desc.data.limit00 = (size - 1) & 0xffff;
873    desc.data.limit16 = ((size - 1) >> 16) & 0xf;
874    desc.data.base00 = addr & 0xffff;
875    desc.data.base16 = (addr >> 16) & 0xff;
876    desc.data.base24 = (addr >> 24) & 0xff;
877    desc.data.type = DESC_DATA_WRITE;
878    desc.data.dpl = USER_PRIV;
879    desc.data.present = 1;
880    desc.data.stksz = DESC_CODE_32B;
881    desc.data.granular = DESC_GRAN_BYTE;
882   
883    i = i386_set_ldt(LDT_AUTO_ALLOC, &desc, 1);
884
885    if (i < 0) {
886        perror("i386_set_ldt");
887    } else {
888        sel.index = i;
889        sel.rpl = USER_PRIV;
890        sel.ti = SEL_LDT;
891        tcr->ldt_selector = sel;
892    }
893}
894
895void free_tcr_extra_segment(TCR *tcr)
896{
897  /* load %fs with null segement selector */
898  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
899  if (i386_set_ldt(tcr->ldt_selector.index, NULL, 1) < 0)
900    perror("i386_set_ldt");
901  tcr->ldt_selector = NULL_SEL;
902}
903#endif
904
905#ifdef LINUX
906
907#include <asm/ldt.h>
908#include <sys/syscall.h>
909
910/* see desc_struct in kernel/include/asm-i386/processor.h */
911typedef struct {
912  uint32_t a;
913  uint32_t b;
914} linux_desc_struct;
915
916
917#define desc_avail(d) (((d)->a) == 0)
918
919linux_desc_struct linux_ldt_entries[LDT_ENTRIES];
920
921/* We have to ask the Linux kernel for a copy of the ldt table
922   and manage it ourselves.  It's not clear that this is
923   thread-safe in general, but we can at least ensure that
924   it's thread-safe wrt lisp threads. */
925
926pthread_mutex_t ldt_lock = PTHREAD_MUTEX_INITIALIZER;  /* simple, non-recursive mutex */
927
928int
929modify_ldt(int func, void *ptr, unsigned long bytecount)
930{
931  return syscall(__NR_modify_ldt, func, ptr, bytecount);
932}
933
934
935void
936setup_tcr_extra_segment(TCR *tcr)
937{
938  int i, n;
939  short sel;
940  struct user_desc u = {1, 0, 0, 1, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 1};
941  linux_desc_struct *d = linux_ldt_entries;
942
943  pthread_mutex_lock(&ldt_lock);
944  n = modify_ldt(0,d,LDT_ENTRIES*LDT_ENTRY_SIZE)/LDT_ENTRY_SIZE;
945  for (i = 0; i < n; i++,d++) {
946    if (desc_avail(d)) {
947      break;
948    }
949  }
950  if (i == LDT_ENTRIES) {
951    pthread_mutex_unlock(&ldt_lock);
952    fprintf(stderr, "All 8192 ldt entries in use ?\n");
953    _exit(1);
954  }
955  u.entry_number = i;
956  u.base_addr = (uint32_t)tcr;
957  u.limit = sizeof(TCR);
958  u.limit_in_pages = 0;
959  if (modify_ldt(1,&u,sizeof(struct user_desc)) != 0) {
960    pthread_mutex_unlock(&ldt_lock);
961    fprintf(stderr,"Can't assign LDT entry\n");
962    _exit(1);
963  }
964  sel = (i << 3) | 7;
965  tcr->ldt_selector = sel;
966  pthread_mutex_unlock(&ldt_lock);
967}
968
969void
970free_tcr_extra_segment(TCR *tcr)
971{
972  struct user_desc u = {0, 0, 0, 0, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 0};
973  short sel = tcr->ldt_selector;
974
975  pthread_mutex_lock(&ldt_lock);
976  /* load %fs with null segement selector */
977  __asm__ volatile ("mov %0,%%fs" : : "r"(0));
978  tcr->ldt_selector = 0;
979  u.entry_number = (sel>>3);
980  modify_ldt(1,&u,sizeof(struct user_desc));
981  pthread_mutex_unlock(&ldt_lock);
982 
983}
984
985#endif
986
987#ifdef WINDOWS
988bitvector ldt_entries_in_use = NULL;
989HANDLE ldt_lock;
990
991typedef struct {
992  DWORD offset;
993  DWORD size;
994  LDT_ENTRY entry;
995} win32_ldt_info;
996
997
998int WINAPI (*NtQueryInformationProcess)(HANDLE,DWORD,VOID*,DWORD,DWORD*);
999int WINAPI (*NtSetInformationProcess)(HANDLE,DWORD,VOID*,DWORD);
1000
1001void
1002init_win32_ldt()
1003{
1004  HANDLE hNtdll;
1005  int status = 0xc0000002;
1006  win32_ldt_info info;
1007  DWORD nret;
1008 
1009
1010  ldt_entries_in_use=malloc(8192/8);
1011  zero_bits(ldt_entries_in_use,8192);
1012  ldt_lock = CreateMutex(NULL,0,NULL);
1013
1014  hNtdll = LoadLibrary("ntdll.dll");
1015  NtQueryInformationProcess = (void*)GetProcAddress(hNtdll, "NtQueryInformationProcess");
1016  NtSetInformationProcess = (void*)GetProcAddress(hNtdll, "NtSetInformationProcess");
1017  if (NtQueryInformationProcess != NULL) {
1018    info.offset = 0;
1019    info.size = sizeof(LDT_ENTRY);
1020    status = NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1021  }
1022
1023  if (status) {
1024    fprintf(stderr, "This application can't run under this OS version\n");
1025    _exit(1);
1026  }
1027}
1028
1029void
1030setup_tcr_extra_segment(TCR *tcr)
1031{
1032  int i, status;
1033  DWORD nret;
1034  win32_ldt_info info;
1035  LDT_ENTRY *entry = &(info.entry);
1036  DWORD *words = (DWORD *)entry, tcraddr = (DWORD)tcr;
1037
1038
1039  WaitForSingleObject(ldt_lock,INFINITE);
1040
1041  for (i = 0; i < 8192; i++) {
1042    if (!ref_bit(ldt_entries_in_use,i)) {
1043      info.offset = i << 3;
1044      info.size = sizeof(LDT_ENTRY);
1045      words[0] = 0;
1046      words[1] = 0;
1047      status = NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1048      if (status == 0) {
1049        if ((info.size == 0) ||
1050            ((words[0] == 0) && (words[1] == 0))) {
1051          break;
1052        }
1053      }
1054    }
1055  }
1056  if (i == 8192) {
1057    ReleaseMutex(ldt_lock);
1058    fprintf(stderr, "All 8192 ldt entries in use ?\n");
1059    _exit(1);
1060  }
1061  set_bit(ldt_entries_in_use,i);
1062  words[0] = 0;
1063  words[1] = 0;
1064  entry->LimitLow = sizeof(TCR);
1065  entry->BaseLow = tcraddr & 0xffff;
1066  entry->HighWord.Bits.BaseMid = (tcraddr >> 16) & 0xff;
1067  entry->HighWord.Bits.BaseHi = (tcraddr >> 24);
1068  entry->HighWord.Bits.Pres = 1;
1069  entry->HighWord.Bits.Default_Big = 1;
1070  entry->HighWord.Bits.Type = 16 | 2; /* read-write data */
1071  entry->HighWord.Bits.Dpl = 3; /* for use by the great unwashed */
1072  info.size = sizeof(LDT_ENTRY);
1073  status = NtSetInformationProcess(GetCurrentProcess(),10,&info,sizeof(info));
1074  if (status != 0) {
1075    ReleaseMutex(ldt_lock);
1076    FBug(NULL, "can't set LDT entry %d, status = 0x%x", i, status);
1077  }
1078#if 1
1079  /* Sanity check */
1080  info.offset = i << 3;
1081  info.size = sizeof(LDT_ENTRY);
1082  words[0] = 0;
1083  words[0] = 0;
1084  NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
1085  if (((entry->BaseLow)|((entry->HighWord.Bits.BaseMid)<<16)|((entry->HighWord.Bits.BaseHi)<<24)) != tcraddr) {
1086    Bug(NULL, "you blew it: bad address in ldt entry\n");
1087  }
1088#endif
1089  tcr->ldt_selector = (i << 3) | 7;
1090  ReleaseMutex(ldt_lock);
1091}
1092
1093void 
1094free_tcr_extra_segment(TCR *tcr)
1095{
1096}
1097
1098#endif
1099#endif
1100
1101/*
1102  Caller must hold the area_lock.
1103*/
1104TCR *
1105new_tcr(natural vstack_size, natural tstack_size)
1106{
1107  extern area
1108    *allocate_vstack_holding_area_lock(natural),
1109    *allocate_tstack_holding_area_lock(natural);
1110  area *a;
1111  int i;
1112#ifndef WINDOWS
1113  sigset_t sigmask;
1114
1115  sigemptyset(&sigmask);
1116  pthread_sigmask(SIG_SETMASK,&sigmask, NULL);
1117#endif
1118
1119#ifdef HAVE_TLS
1120  TCR *tcr = &current_tcr;
1121#else /* no TLS */
1122  TCR *tcr = allocate_tcr();
1123#endif
1124
1125#ifdef X86
1126  setup_tcr_extra_segment(tcr);
1127  tcr->linear = tcr;
1128#ifdef X8632
1129  tcr->node_regs_mask = X8632_DEFAULT_NODE_REGS_MASK;
1130#endif
1131#endif
1132
1133#if (WORD_SIZE == 64)
1134  tcr->single_float_convert.tag = subtag_single_float;
1135#endif
1136  lisp_global(TCR_COUNT) += (1<<fixnumshift);
1137  tcr->suspend = new_semaphore(0);
1138  tcr->resume = new_semaphore(0);
1139  tcr->reset_completion = new_semaphore(0);
1140  tcr->activate = new_semaphore(0);
1141  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1142  a = allocate_vstack_holding_area_lock(vstack_size);
1143  tcr->vs_area = a;
1144  a->owner = tcr;
1145  tcr->save_vsp = (LispObj *) a->active; 
1146  a = allocate_tstack_holding_area_lock(tstack_size);
1147  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1148  tcr->ts_area = a;
1149  a->owner = tcr;
1150  tcr->save_tsp = (LispObj *) a->active;
1151#ifdef X86
1152  tcr->next_tsp = tcr->save_tsp;
1153#endif
1154
1155  tcr->valence = TCR_STATE_FOREIGN;
1156#ifdef PPC
1157  tcr->lisp_fpscr.words.l = 0xd0;
1158#endif
1159#ifdef X86
1160  tcr->lisp_mxcsr = (1 << MXCSR_DM_BIT) | 
1161#if 1                           /* Mask underflow; too hard to
1162                                   deal with denorms if underflow is
1163                                   enabled */
1164    (1 << MXCSR_UM_BIT) | 
1165#endif
1166    (1 << MXCSR_PM_BIT);
1167#endif
1168  tcr->save_allocbase = tcr->save_allocptr = (void *) VOID_ALLOCPTR;
1169  tcr->tlb_limit = 2048<<fixnumshift;
1170  tcr->tlb_pointer = (LispObj *)malloc(tcr->tlb_limit);
1171  for (i = 0; i < 2048; i++) {
1172    tcr->tlb_pointer[i] = (LispObj) no_thread_local_binding_marker;
1173  }
1174  TCR_INTERRUPT_LEVEL(tcr) = (LispObj) (-1<<fixnum_shift);
1175#ifndef WINDOWS
1176  tcr->shutdown_count = PTHREAD_DESTRUCTOR_ITERATIONS;
1177#endif
1178  return tcr;
1179}
1180
1181void
1182shutdown_thread_tcr(void *arg)
1183{
1184  TCR *tcr = TCR_FROM_TSD(arg);
1185
1186  area *vs, *ts, *cs;
1187  void *termination_semaphore;
1188 
1189  if (--(tcr->shutdown_count) == 0) {
1190    if (tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN)) {
1191      LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
1192        callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
1193   
1194      tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1195      ((void (*)())ptr_from_lispobj(callback_ptr))(1);
1196      tsd_set(lisp_global(TCR_KEY), NULL);
1197    }
1198#ifdef DARWIN
1199    darwin_exception_cleanup(tcr);
1200#endif
1201    LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1202    vs = tcr->vs_area;
1203    tcr->vs_area = NULL;
1204    ts = tcr->ts_area;
1205    tcr->ts_area = NULL;
1206    cs = tcr->cs_area;
1207    tcr->cs_area = NULL;
1208    if (vs) {
1209      condemn_area_holding_area_lock(vs);
1210    }
1211    if (ts) {
1212      condemn_area_holding_area_lock(ts);
1213    }
1214    if (cs) {
1215      condemn_area_holding_area_lock(cs);
1216    }
1217    destroy_semaphore(&tcr->suspend);
1218    destroy_semaphore(&tcr->resume);
1219    destroy_semaphore(&tcr->reset_completion);
1220    destroy_semaphore(&tcr->activate);
1221    tcr->tlb_limit = 0;
1222    free(tcr->tlb_pointer);
1223    tcr->tlb_pointer = NULL;
1224    tcr->osid = 0;
1225    tcr->interrupt_pending = 0;
1226    termination_semaphore = tcr->termination_semaphore;
1227    tcr->termination_semaphore = NULL;
1228#ifdef HAVE_TLS
1229    dequeue_tcr(tcr);
1230#endif
1231#ifdef X8632
1232    free_tcr_extra_segment(tcr);
1233#endif
1234    UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1235    if (termination_semaphore) {
1236      SEM_RAISE(termination_semaphore);
1237    }
1238  } else {
1239    tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1240  }
1241}
1242
1243void
1244tcr_cleanup(void *arg)
1245{
1246  TCR *tcr = (TCR *)arg;
1247  area *a;
1248
1249  a = tcr->vs_area;
1250  if (a) {
1251    a->active = a->high;
1252  }
1253  a = tcr->ts_area;
1254  if (a) {
1255    a->active = a->high;
1256  }
1257  a = tcr->cs_area;
1258  if (a) {
1259    a->active = a->high;
1260  }
1261  tcr->valence = TCR_STATE_FOREIGN;
1262  tcr->shutdown_count = 1;
1263  shutdown_thread_tcr(tcr);
1264  tsd_set(lisp_global(TCR_KEY), NULL);
1265}
1266
1267void *
1268current_native_thread_id()
1269{
1270  return ((void *) (natural)
1271#ifdef LINUX
1272          getpid()
1273#endif
1274#ifdef DARWIN
1275          mach_thread_self()
1276#endif
1277#ifdef FREEBSD
1278          pthread_self()
1279#endif
1280#ifdef SOLARIS
1281          pthread_self()
1282#endif
1283#ifdef WINDOWS
1284          GetCurrentThreadId()
1285#endif
1286          );
1287}
1288
1289
1290void
1291thread_init_tcr(TCR *tcr, void *stack_base, natural stack_size)
1292{
1293  area *a, *register_cstack_holding_area_lock(BytePtr, natural);
1294
1295  tcr->osid = current_thread_osid();
1296  tcr->native_thread_id = current_native_thread_id();
1297  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1298  a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size);
1299  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1300  tcr->cs_area = a;
1301  a->owner = tcr;
1302  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
1303    tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
1304  }
1305#ifdef LINUX
1306#ifdef PPC
1307#ifndef PPC64
1308  tcr->native_thread_info = current_r2;
1309#endif
1310#endif
1311#endif
1312  tcr->errno_loc = &errno;
1313  tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1314#ifdef DARWIN
1315  extern Boolean use_mach_exception_handling;
1316  if (use_mach_exception_handling) {
1317    darwin_exception_init(tcr);
1318  }
1319#endif
1320#ifdef LINUX
1321  linux_exception_init(tcr);
1322#endif
1323  tcr->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
1324}
1325
1326/*
1327  Register the specified tcr as "belonging to" the current thread.
1328  Under Darwin, setup Mach exception handling for the thread.
1329  Install cleanup handlers for thread termination.
1330*/
1331void
1332register_thread_tcr(TCR *tcr)
1333{
1334  void *stack_base = NULL;
1335  natural stack_size = 0;
1336
1337  os_get_current_thread_stack_bounds(&stack_base, &stack_size);
1338  thread_init_tcr(tcr, stack_base, stack_size);
1339  enqueue_tcr(tcr);
1340}
1341
1342
1343 
1344 
1345#ifndef MAP_GROWSDOWN
1346#define MAP_GROWSDOWN 0
1347#endif
1348
1349Ptr
1350create_stack(natural size)
1351{
1352  Ptr p;
1353  size=align_to_power_of_2(size, log2_page_size);
1354  p = (Ptr) MapMemoryForStack((size_t)size);
1355  if (p != (Ptr)(-1)) {
1356    *((size_t *)p) = size;
1357    return p;
1358  }
1359  allocation_failure(true, size);
1360
1361}
1362
1363void *
1364allocate_stack(natural size)
1365{
1366  return create_stack(size);
1367}
1368
1369void
1370free_stack(void *s)
1371{
1372  size_t size = *((size_t *)s);
1373  UnMapMemory(s, size);
1374}
1375
1376Boolean threads_initialized = false;
1377
1378#ifndef USE_FUTEX
1379#ifdef WINDOWS
1380void
1381count_cpus()
1382{
1383  SYSTEM_INFO si;
1384
1385  GetSystemInfo(&si);
1386  if (si.dwNumberOfProcessors > 1) {
1387    spin_lock_tries = 1024;
1388  }
1389}
1390#else
1391void
1392count_cpus()
1393{
1394#ifdef DARWIN
1395  /* As of OSX 10.4, Darwin doesn't define _SC_NPROCESSORS_ONLN */
1396#include <mach/host_info.h>
1397
1398  struct host_basic_info info;
1399  mach_msg_type_number_t count = HOST_BASIC_INFO_COUNT;
1400 
1401  if (KERN_SUCCESS == host_info(mach_host_self(), HOST_BASIC_INFO,(host_info_t)(&info),&count)) {
1402    if (info.max_cpus > 1) {
1403      spin_lock_tries = 1024;
1404    }
1405  }
1406#else
1407  int n = sysconf(_SC_NPROCESSORS_ONLN);
1408 
1409  if (n > 1) {
1410    spin_lock_tries = 1024;
1411  }
1412#endif
1413}
1414#endif
1415#endif
1416
1417void
1418init_threads(void * stack_base, TCR *tcr)
1419{
1420  lisp_global(INITIAL_TCR) = (LispObj)ptr_to_lispobj(tcr);
1421#ifdef WINDOWS
1422  lisp_global(TCR_KEY) = TlsAlloc();
1423  pCancelIoEx = windows_find_symbol(NULL, "CancelIoEx");
1424#else
1425  pthread_key_create((pthread_key_t *)&(lisp_global(TCR_KEY)), shutdown_thread_tcr);
1426  thread_signal_setup();
1427#endif
1428 
1429#ifndef USE_FUTEX
1430  count_cpus();
1431#endif
1432  threads_initialized = true;
1433}
1434
1435
1436#ifdef WINDOWS
1437unsigned CALLBACK
1438#else
1439void *
1440#endif
1441lisp_thread_entry(void *param)
1442{
1443  thread_activation *activation = (thread_activation *)param;
1444  TCR *tcr = new_tcr(activation->vsize, activation->tsize);
1445#ifndef WINDOWS
1446  sigset_t mask, old_mask;
1447
1448  sigemptyset(&mask);
1449  pthread_sigmask(SIG_SETMASK, &mask, &old_mask);
1450#endif
1451
1452  register_thread_tcr(tcr);
1453
1454#ifndef WINDOWS
1455  pthread_cleanup_push(tcr_cleanup,(void *)tcr);
1456#endif
1457  tcr->vs_area->active -= node_size;
1458  *(--tcr->save_vsp) = lisp_nil;
1459  enable_fp_exceptions();
1460  SET_TCR_FLAG(tcr,TCR_FLAG_BIT_AWAITING_PRESET);
1461  activation->tcr = tcr;
1462  SEM_RAISE(activation->created);
1463  do {
1464    SEM_RAISE(tcr->reset_completion);
1465    SEM_WAIT_FOREVER(tcr->activate);
1466    /* Now go run some lisp code */
1467    start_lisp(TCR_TO_TSD(tcr),0);
1468  } while (tcr->flags & (1<<TCR_FLAG_BIT_AWAITING_PRESET));
1469#ifndef WINDOWS
1470  pthread_cleanup_pop(true);
1471#else
1472  tcr_cleanup(tcr);
1473#endif
1474#ifdef WINDOWS
1475  return 0;
1476#else
1477  return NULL;
1478#endif
1479}
1480
1481void *
1482xNewThread(natural control_stack_size,
1483           natural value_stack_size,
1484           natural temp_stack_size)
1485
1486{
1487  thread_activation activation;
1488
1489
1490  activation.tsize = temp_stack_size;
1491  activation.vsize = value_stack_size;
1492  activation.tcr = 0;
1493  activation.created = new_semaphore(0);
1494  if (create_system_thread(control_stack_size +(CSTACK_HARDPROT+CSTACK_SOFTPROT), 
1495                           NULL, 
1496                           lisp_thread_entry,
1497                           (void *) &activation)) {
1498   
1499    SEM_WAIT_FOREVER(activation.created);       /* Wait until thread's entered its initial function */
1500  }
1501  destroy_semaphore(&activation.created); 
1502  return TCR_TO_TSD(activation.tcr);
1503}
1504
1505Boolean
1506active_tcr_p(TCR *q)
1507{
1508  TCR *head = (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR)), *p = head;
1509 
1510  do {
1511    if (p == q) {
1512      return true;
1513    }
1514    p = p->next;
1515  } while (p != head);
1516  return false;
1517}
1518
1519#ifdef WINDOWS
1520OSErr
1521xDisposeThread(TCR *tcr)
1522{
1523  return 0;                     /* I don't think that this is ever called. */
1524}
1525#else
1526OSErr
1527xDisposeThread(TCR *tcr)
1528{
1529  if (tcr != (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR))) {
1530    if (active_tcr_p(tcr) && (tcr != get_tcr(false))) {
1531      pthread_cancel((pthread_t)(tcr->osid));
1532      return 0;
1533    }
1534  }
1535  return -50;
1536}
1537#endif
1538
1539OSErr
1540xYieldToThread(TCR *target)
1541{
1542  Bug(NULL, "xYieldToThread ?");
1543  return 0;
1544}
1545 
1546OSErr
1547xThreadCurrentStackSpace(TCR *tcr, unsigned *resultP)
1548{
1549  Bug(NULL, "xThreadCurrentStackSpace ?");
1550  return 0;
1551}
1552
1553
1554#ifdef WINDOWS
1555LispObj
1556create_system_thread(size_t stack_size,
1557                     void* stackaddr,
1558                     unsigned CALLBACK (*start_routine)(void *),
1559                     void* param)
1560{
1561  HANDLE thread_handle;
1562
1563  stack_size = ((stack_size+(((1<<16)-1)))&~((1<<16)-1));
1564
1565  thread_handle = (HANDLE)_beginthreadex(NULL, 
1566                                         0/*stack_size*/,
1567                                         start_routine,
1568                                         param,
1569                                         0, 
1570                                         NULL);
1571
1572  if (thread_handle == NULL) {
1573    wperror("CreateThread");
1574  }
1575  return (LispObj) ptr_to_lispobj(thread_handle);
1576}
1577#else
1578LispObj
1579create_system_thread(size_t stack_size,
1580                     void* stackaddr,
1581                     void* (*start_routine)(void *),
1582                     void* param)
1583{
1584  pthread_attr_t attr;
1585  pthread_t returned_thread = (pthread_t) 0;
1586
1587  pthread_attr_init(&attr);
1588  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); 
1589
1590  if (stack_size == MINIMAL_THREAD_STACK_SIZE) {
1591    stack_size = PTHREAD_STACK_MIN;
1592  }
1593
1594  stack_size = ensure_stack_limit(stack_size);
1595  if (stackaddr != NULL) {
1596    /* Size must have been specified.  Sort of makes sense ... */
1597#ifdef DARWIN
1598    Fatal("no pthread_attr_setsetstack. "," Which end of stack does address refer to?");
1599#else
1600    pthread_attr_setstack(&attr, stackaddr, stack_size);
1601#endif
1602  } else if (stack_size != DEFAULT_THREAD_STACK_SIZE) {
1603    pthread_attr_setstacksize(&attr,stack_size);
1604  }
1605
1606  /*
1607     I think that's just about enough ... create the thread.
1608  */
1609  pthread_create(&returned_thread, &attr, start_routine, param);
1610  pthread_attr_destroy(&attr);
1611  return (LispObj) ptr_to_lispobj(returned_thread);
1612}
1613#endif
1614
1615TCR *
1616get_tcr(Boolean create)
1617{
1618#ifdef HAVE_TLS
1619  TCR *current = current_tcr.linear;
1620#else
1621  void *tsd = (void *)tsd_get(lisp_global(TCR_KEY));
1622  TCR *current = (tsd == NULL) ? NULL : TCR_FROM_TSD(tsd);
1623#endif
1624
1625  if ((current == NULL) && create) {
1626    LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
1627      callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
1628    int i, nbindwords = 0;
1629    extern unsigned initial_stack_size;
1630   
1631    /* Make one. */
1632    current = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
1633    SET_TCR_FLAG(current,TCR_FLAG_BIT_FOREIGN);
1634    register_thread_tcr(current);
1635#ifdef DEBUG_TCR_CREATION
1636#ifndef WINDOWS
1637    fprintf(stderr, "\ncreating TCR for pthread 0x%x", pthread_self());
1638#endif
1639#endif
1640    current->vs_area->active -= node_size;
1641    *(--current->save_vsp) = lisp_nil;
1642#ifdef PPC
1643#define NSAVEREGS 8
1644#endif
1645#ifdef X8664
1646#define NSAVEREGS 4
1647#endif
1648#ifdef X8632
1649#define NSAVEREGS 0
1650#endif
1651    for (i = 0; i < NSAVEREGS; i++) {
1652      *(--current->save_vsp) = 0;
1653      current->vs_area->active -= node_size;
1654    }
1655    nbindwords = ((int (*)())ptr_from_lispobj(callback_ptr))(-1);
1656    for (i = 0; i < nbindwords; i++) {
1657      *(--current->save_vsp) = 0;
1658      current->vs_area->active -= node_size;
1659    }
1660    current->shutdown_count = 1;
1661    ((void (*)())ptr_from_lispobj(callback_ptr))(0);
1662
1663  }
1664 
1665  return current;
1666}
1667
1668#ifdef WINDOWS
1669
1670Boolean
1671suspend_tcr(TCR *tcr)
1672{
1673  int suspend_count = atomic_incf(&(tcr->suspend_count));
1674  DWORD rc;
1675  if (suspend_count == 1) {
1676    /* Can't seem to get gcc to align a CONTEXT structure correctly */
1677    char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
1678
1679    CONTEXT *suspend_context, *pcontext;
1680    HANDLE hthread = (HANDLE)(tcr->osid);
1681    pc where;
1682    area *cs = tcr->cs_area;
1683    LispObj foreign_rsp;
1684
1685    pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
1686
1687    rc = SuspendThread(hthread);
1688    if (rc == -1) {
1689      /* If the thread's simply dead, we should handle that here */
1690      return false;
1691    }
1692    pcontext->ContextFlags = CONTEXT_ALL;
1693    rc = GetThreadContext(hthread, pcontext);
1694    if (rc == 0) {
1695      return false;
1696    }
1697    where = (pc)(xpPC(pcontext));
1698
1699    if (tcr->valence == TCR_STATE_LISP) {
1700      if ((where >= restore_windows_context_start) &&
1701          (where < restore_windows_context_end)) {
1702        /* Thread has started to return from an exception. */
1703        if (where < restore_windows_context_load_rcx) {
1704          /* In the process of restoring registers; context still in
1705             %rcx.  Just make our suspend_context be the context
1706             we're trying to restore, so that we'll resume from
1707             the suspend in the same context that we're trying to
1708             restore */
1709#ifdef WIN_64
1710          *pcontext = * (CONTEXT *)(pcontext->Rcx);
1711#endif
1712        } else {
1713          /* Most of the context has already been restored; fix %rcx
1714             if need be, then restore ss:rsp, cs:rip, and flags. */
1715#ifdef WIN64
1716          x64_iret_frame *iret_frame = (x64_iret_frame *) (pcontext->Rsp);
1717          if (where == restore_windows_context_load_rcx) {
1718            pcontext->Rcx = ((CONTEXT*)(pcontext->Rcx))->Rcx;
1719          }
1720          pcontext->Rip = iret_frame->Rip;
1721          pcontext->SegCs = (WORD) iret_frame->Cs;
1722          pcontext->EFlags = (DWORD) iret_frame->Rflags;
1723          pcontext->Rsp = iret_frame->Rsp;
1724          pcontext->SegSs = (WORD) iret_frame->Ss;
1725#else
1726#warning need context setup for win32
1727#endif
1728        }
1729        tcr->suspend_context = NULL;
1730      } else {
1731        area *ts = tcr->ts_area;
1732        /* If we're in the lisp heap, or in x86-spentry64.o, or in
1733           x86-subprims64.o, or in the subprims jump table at #x15000,
1734           or on the tstack ... we're just executing lisp code.  Otherwise,
1735           we got an exception while executing lisp code, but haven't
1736           yet entered the handler yet (still in Windows exception glue
1737           or switching stacks or something.)  In the latter case, we
1738           basically want to get to he handler and have it notice
1739           the pending exception request, and suspend the thread at that
1740           point. */
1741        if (!((where < (pc)lisp_global(HEAP_END)) &&
1742              (where >= (pc)lisp_global(HEAP_START))) &&
1743            !((where < spentry_end) && (where >= spentry_start)) &&
1744            !((where < subprims_end) && (where >= subprims_start)) &&
1745            !((where < (pc) 0x16000) &&
1746              (where >= (pc) 0x15000)) &&
1747            !((where < (pc) (ts->high)) &&
1748              (where >= (pc) (ts->low)))) {
1749          /* The thread has lisp valence, but is not executing code
1750             where we expect lisp code to be and is not exiting from
1751             an exception handler.  That pretty much means that it's
1752             on its way into an exception handler; we have to handshake
1753             until it enters an exception-wait state. */
1754          /* There are likely race conditions here */
1755          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
1756          ResumeThread(hthread);
1757          SEM_WAIT_FOREVER(tcr->suspend);
1758          SuspendThread(hthread);
1759          /* The thread is either waiting for its resume semaphore to
1760             be signaled or is about to wait.  Signal it now, while
1761             the thread's suspended. */
1762          SEM_RAISE(tcr->resume);
1763          pcontext->ContextFlags = CONTEXT_ALL;
1764          GetThreadContext(hthread, pcontext);
1765        }
1766      }
1767    } else {
1768      if (tcr->valence == TCR_STATE_EXCEPTION_RETURN) {
1769        *pcontext = *tcr->pending_exception_context;
1770        tcr->pending_exception_context = NULL;
1771        tcr->valence = TCR_STATE_LISP;
1772      }
1773    }
1774
1775    /* If the context's stack pointer is pointing into the cs_area,
1776       copy the context below the stack pointer. else copy it
1777       below tcr->foreign_rsp. */
1778    foreign_rsp = xpGPR(pcontext,Isp);
1779
1780    if ((foreign_rsp < (LispObj)(cs->low)) ||
1781        (foreign_rsp >= (LispObj)(cs->high))) {
1782      foreign_rsp = (LispObj)(tcr->foreign_sp);
1783    }
1784    foreign_rsp -= 0x200;
1785    foreign_rsp &= ~15;
1786    suspend_context = (CONTEXT *)(foreign_rsp)-1;
1787    *suspend_context = *pcontext;
1788    tcr->suspend_context = suspend_context;
1789    return true;
1790  }
1791  return false;
1792}
1793#else
1794Boolean
1795suspend_tcr(TCR *tcr)
1796{
1797  int suspend_count = atomic_incf(&(tcr->suspend_count));
1798  pthread_t thread;
1799  if (suspend_count == 1) {
1800    thread = (pthread_t)(tcr->osid);
1801    if ((thread != (pthread_t) 0) &&
1802        (pthread_kill(thread, thread_suspend_signal) == 0)) {
1803      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1804    } else {
1805      /* A problem using pthread_kill.  On Darwin, this can happen
1806         if the thread has had its signal mask surgically removed
1807         by pthread_exit.  If the native (Mach) thread can be suspended,
1808         do that and return true; otherwise, flag the tcr as belonging
1809         to a dead thread by setting tcr->osid to 0.
1810      */
1811      tcr->osid = 0;
1812      return false;
1813    }
1814    return true;
1815  }
1816  return false;
1817}
1818#endif
1819
1820#ifdef WINDOWS
1821Boolean
1822tcr_suspend_ack(TCR *tcr)
1823{
1824  return true;
1825}
1826#else
1827Boolean
1828tcr_suspend_ack(TCR *tcr)
1829{
1830  if (tcr->flags & (1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING)) {
1831    SEM_WAIT_FOREVER(tcr->suspend);
1832    tcr->flags &= ~(1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1833  }
1834  return true;
1835}
1836#endif
1837     
1838
1839
1840Boolean
1841lisp_suspend_tcr(TCR *tcr)
1842{
1843  Boolean suspended;
1844  TCR *current = get_tcr(true);
1845 
1846  LOCK(lisp_global(TCR_AREA_LOCK),current);
1847  suspended = suspend_tcr(tcr);
1848  if (suspended) {
1849    while (!tcr_suspend_ack(tcr));
1850  }
1851  UNLOCK(lisp_global(TCR_AREA_LOCK),current);
1852  return suspended;
1853}
1854         
1855#ifdef WINDOWS
1856Boolean
1857resume_tcr(TCR *tcr)
1858{
1859  int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
1860  DWORD rc;
1861  if (suspend_count == 0) {
1862    CONTEXT *context = tcr->suspend_context;
1863    HANDLE hthread = (HANDLE)(tcr->osid);
1864
1865    if (context == NULL) {
1866      Bug(NULL, "no suspend_context for TCR = 0x" LISP, (natural)tcr);
1867    }
1868    tcr->suspend_context = NULL;
1869    SetThreadContext(hthread,context);
1870    rc = ResumeThread(hthread);
1871    if (rc == -1) {
1872      wperror("ResumeThread");
1873      return false;
1874    }
1875    return true;
1876  }
1877  return false;
1878}   
1879#else
1880Boolean
1881resume_tcr(TCR *tcr)
1882{
1883  int suspend_count = atomic_decf(&(tcr->suspend_count));
1884  if (suspend_count == 0) {
1885    void *s = (tcr->resume);
1886    if (s != NULL) {
1887      SEM_RAISE(s);
1888      return true;
1889    }
1890  }
1891  return false;
1892}
1893#endif
1894
1895   
1896
1897
1898Boolean
1899lisp_resume_tcr(TCR *tcr)
1900{
1901  Boolean resumed;
1902  TCR *current = get_tcr(true);
1903 
1904  LOCK(lisp_global(TCR_AREA_LOCK),current);
1905  resumed = resume_tcr(tcr);
1906  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
1907  return resumed;
1908}
1909
1910
1911TCR *freed_tcrs = NULL;
1912
1913void
1914enqueue_freed_tcr (TCR *tcr)
1915{
1916#ifndef HAVE_TLS
1917  tcr->next = freed_tcrs;
1918  freed_tcrs = tcr;
1919#endif
1920}
1921
1922/* It's not clear that we can safely condemn a dead tcr's areas, since
1923   we may not be able to call free() if a suspended thread owns a
1924   malloc lock. At least make the areas appear to be empty.
1925*/
1926   
1927
1928void
1929normalize_dead_tcr_areas(TCR *tcr)
1930{
1931  area *a;
1932
1933  a = tcr->vs_area;
1934  if (a) {
1935    a->active = a->high;
1936  }
1937
1938  a = tcr->ts_area;
1939  if (a) {
1940    a->active = a->high;
1941  }
1942
1943  a = tcr->cs_area;
1944  if (a) {
1945    a->active = a->high;
1946  }
1947}
1948   
1949void
1950free_freed_tcrs ()
1951{
1952  TCR *current, *next;
1953
1954  for (current = freed_tcrs; current; current = next) {
1955    next = current->next;
1956#ifndef HAVE_TLS
1957#ifdef WIN32
1958    free(current->allocated);
1959#else
1960    free(current);
1961#endif
1962#endif
1963  }
1964  freed_tcrs = NULL;
1965}
1966
1967void
1968suspend_other_threads(Boolean for_gc)
1969{
1970  TCR *current = get_tcr(true), *other, *next;
1971  int dead_tcr_count = 0;
1972  Boolean all_acked;
1973
1974  LOCK(lisp_global(TCR_AREA_LOCK), current);
1975  for (other = current->next; other != current; other = other->next) {
1976    if ((other->osid != 0)) {
1977      suspend_tcr(other);
1978      if (other->osid == 0) {
1979        dead_tcr_count++;
1980      }
1981    } else {
1982      dead_tcr_count++;
1983    }
1984  }
1985
1986  do {
1987    all_acked = true;
1988    for (other = current->next; other != current; other = other->next) {
1989      if ((other->osid != 0)) {
1990        if (!tcr_suspend_ack(other)) {
1991          all_acked = false;
1992        }
1993      }
1994    }
1995  } while(! all_acked);
1996
1997     
1998
1999  /* All other threads are suspended; can safely delete dead tcrs now */
2000  if (dead_tcr_count) {
2001    for (other = current->next; other != current; other = next) {
2002      next = other->next;
2003      if ((other->osid == 0))  {
2004        normalize_dead_tcr_areas(other);
2005        dequeue_tcr(other);
2006        enqueue_freed_tcr(other);
2007      }
2008    }
2009  }
2010}
2011
2012void
2013lisp_suspend_other_threads()
2014{
2015  suspend_other_threads(false);
2016}
2017
2018void
2019resume_other_threads(Boolean for_gc)
2020{
2021  TCR *current = get_tcr(true), *other;
2022  for (other = current->next; other != current; other = other->next) {
2023    if ((other->osid != 0)) {
2024      resume_tcr(other);
2025    }
2026  }
2027  free_freed_tcrs();
2028  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
2029}
2030
2031void
2032lisp_resume_other_threads()
2033{
2034  resume_other_threads(false);
2035}
2036
2037
2038
2039rwlock *
2040rwlock_new()
2041{
2042  extern int cache_block_size;
2043
2044  void *p = calloc(1,sizeof(rwlock)+cache_block_size-1);
2045  rwlock *rw = NULL;;
2046 
2047  if (p) {
2048    rw = (rwlock *) ((((natural)p)+cache_block_size-1) & (~(cache_block_size-1)));
2049    rw->malloced_ptr = p;
2050#ifndef USE_FUTEX
2051    rw->reader_signal = new_semaphore(0);
2052    rw->writer_signal = new_semaphore(0);
2053    if ((rw->reader_signal == NULL) || (rw->writer_signal == NULL)) {
2054      if (rw->reader_signal) {
2055        destroy_semaphore(&(rw->reader_signal));
2056      } else {
2057        destroy_semaphore(&(rw->writer_signal));
2058      }
2059      free(rw);
2060      rw = NULL;
2061    }
2062#endif
2063  }
2064  return rw;
2065}
2066
2067     
2068/*
2069  Try to get read access to a multiple-readers/single-writer lock.  If
2070  we already have read access, return success (indicating that the
2071  lock is held another time.  If we already have write access to the
2072  lock ... that won't work; return EDEADLK.  Wait until no other
2073  thread has or is waiting for write access, then indicate that we
2074  hold read access once.
2075*/
2076#ifndef USE_FUTEX
2077int
2078rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2079{
2080  int err = 0;
2081 
2082  LOCK_SPINLOCK(rw->spin, tcr);
2083
2084  if (rw->writer == tcr) {
2085    RELEASE_SPINLOCK(rw->spin);
2086    return EDEADLK;
2087  }
2088
2089  while (rw->blocked_writers || (rw->state > 0)) {
2090    rw->blocked_readers++;
2091    RELEASE_SPINLOCK(rw->spin);
2092    err = semaphore_maybe_timedwait(rw->reader_signal,waitfor);
2093    LOCK_SPINLOCK(rw->spin,tcr);
2094    rw->blocked_readers--;
2095    if (err == EINTR) {
2096      err = 0;
2097    }
2098    if (err) {
2099      RELEASE_SPINLOCK(rw->spin);
2100      return err;
2101    }
2102  }
2103  rw->state--;
2104  RELEASE_SPINLOCK(rw->spin);
2105  return err;
2106}
2107#else
2108int
2109rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2110{
2111  natural waitval;
2112
2113  lock_futex(&rw->spin);
2114
2115  if (rw->writer == tcr) {
2116    unlock_futex(&rw->spin);
2117    return EDEADLOCK;
2118  }
2119  while (1) {
2120    if (rw->writer == NULL) {
2121      --rw->state;
2122      unlock_futex(&rw->spin);
2123      return 0;
2124    }
2125    rw->blocked_readers++;
2126    waitval = rw->reader_signal;
2127    unlock_futex(&rw->spin);
2128    futex_wait(&rw->reader_signal,waitval);
2129    lock_futex(&rw->spin);
2130    rw->blocked_readers--;
2131  }
2132  return 0;
2133}
2134#endif   
2135
2136
2137/*
2138  Try to obtain write access to the lock.
2139  It is an error if we already have read access, but it's hard to
2140  detect that.
2141  If we already have write access, increment the count that indicates
2142  that.
2143  Otherwise, wait until the lock is not held for reading or writing,
2144  then assert write access.
2145*/
2146
2147#ifndef USE_FUTEX
2148int
2149rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2150{
2151  int err = 0;
2152
2153  LOCK_SPINLOCK(rw->spin,tcr);
2154  if (rw->writer == tcr) {
2155    rw->state++;
2156    RELEASE_SPINLOCK(rw->spin);
2157    return 0;
2158  }
2159
2160  while (rw->state != 0) {
2161    rw->blocked_writers++;
2162    RELEASE_SPINLOCK(rw->spin);
2163    err = semaphore_maybe_timedwait(rw->writer_signal, waitfor);
2164    LOCK_SPINLOCK(rw->spin,tcr);
2165    rw->blocked_writers--;
2166    if (err == EINTR) {
2167      err = 0;
2168    }
2169    if (err) {
2170      RELEASE_SPINLOCK(rw->spin);
2171      return err;
2172    }
2173  }
2174  rw->state = 1;
2175  rw->writer = tcr;
2176  RELEASE_SPINLOCK(rw->spin);
2177  return err;
2178}
2179
2180#else
2181int
2182rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2183{
2184  int err = 0;
2185  natural waitval;
2186
2187  lock_futex(&rw->spin);
2188  if (rw->writer == tcr) {
2189    rw->state++;
2190    unlock_futex(&rw->spin);
2191    return 0;
2192  }
2193
2194  while (rw->state != 0) {
2195    rw->blocked_writers++;
2196    waitval = rw->writer_signal;
2197    unlock_futex(&rw->spin);
2198    futex_wait(&rw->writer_signal,waitval);
2199    lock_futex(&rw->spin);
2200    rw->blocked_writers--;
2201  }
2202  rw->state = 1;
2203  rw->writer = tcr;
2204  unlock_futex(&rw->spin);
2205  return err;
2206}
2207#endif
2208
2209/*
2210  Sort of the same as above, only return EBUSY if we'd have to wait.
2211*/
2212#ifndef USE_FUTEX
2213int
2214rwlock_try_wlock(rwlock *rw, TCR *tcr)
2215{
2216  int ret = EBUSY;
2217
2218  LOCK_SPINLOCK(rw->spin,tcr);
2219  if (rw->writer == tcr) {
2220    rw->state++;
2221    ret = 0;
2222  } else {
2223    if (rw->state == 0) {
2224      rw->writer = tcr;
2225      rw->state = 1;
2226      ret = 0;
2227    }
2228  }
2229  RELEASE_SPINLOCK(rw->spin);
2230  return ret;
2231}
2232#else
2233int
2234rwlock_try_wlock(rwlock *rw, TCR *tcr)
2235{
2236  int ret = EBUSY;
2237
2238  lock_futex(&rw->spin);
2239  if (rw->writer == tcr) {
2240    rw->state++;
2241    ret = 0;
2242  } else {
2243    if (rw->state == 0) {
2244      rw->writer = tcr;
2245      rw->state = 1;
2246      ret = 0;
2247    }
2248  }
2249  unlock_futex(&rw->spin);
2250  return ret;
2251}
2252#endif
2253
2254#ifndef USE_FUTEX
2255int
2256rwlock_try_rlock(rwlock *rw, TCR *tcr)
2257{
2258  int ret = EBUSY;
2259
2260  LOCK_SPINLOCK(rw->spin,tcr);
2261  if (rw->state <= 0) {
2262    --rw->state;
2263    ret = 0;
2264  }
2265  RELEASE_SPINLOCK(rw->spin);
2266  return ret;
2267}
2268#else
2269int
2270rwlock_try_rlock(rwlock *rw, TCR *tcr)
2271{
2272  int ret = EBUSY;
2273
2274  lock_futex(&rw->spin);
2275  if (rw->state <= 0) {
2276    --rw->state;
2277    ret = 0;
2278  }
2279  unlock_futex(&rw->spin);
2280  return ret;
2281}
2282#endif
2283
2284
2285
2286#ifndef USE_FUTEX
2287int
2288rwlock_unlock(rwlock *rw, TCR *tcr)
2289{
2290
2291  int err = 0;
2292  natural blocked_readers = 0;
2293
2294  LOCK_SPINLOCK(rw->spin,tcr);
2295  if (rw->state > 0) {
2296    if (rw->writer != tcr) {
2297      err = EINVAL;
2298    } else {
2299      --rw->state;
2300      if (rw->state == 0) {
2301        rw->writer = NULL;
2302      }
2303    }
2304  } else {
2305    if (rw->state < 0) {
2306      ++rw->state;
2307    } else {
2308      err = EINVAL;
2309    }
2310  }
2311  if (err) {
2312    RELEASE_SPINLOCK(rw->spin);
2313    return err;
2314  }
2315 
2316  if (rw->state == 0) {
2317    if (rw->blocked_writers) {
2318      SEM_RAISE(rw->writer_signal);
2319    } else {
2320      blocked_readers = rw->blocked_readers;
2321      if (blocked_readers) {
2322        SEM_BROADCAST(rw->reader_signal, blocked_readers);
2323      }
2324    }
2325  }
2326  RELEASE_SPINLOCK(rw->spin);
2327  return 0;
2328}
2329#else
2330int
2331rwlock_unlock(rwlock *rw, TCR *tcr)
2332{
2333
2334  int err = 0;
2335
2336  lock_futex(&rw->spin);
2337  if (rw->state > 0) {
2338    if (rw->writer != tcr) {
2339      err = EINVAL;
2340    } else {
2341      --rw->state;
2342      if (rw->state == 0) {
2343        rw->writer = NULL;
2344      }
2345    }
2346  } else {
2347    if (rw->state < 0) {
2348      ++rw->state;
2349    } else {
2350      err = EINVAL;
2351    }
2352  }
2353  if (err) {
2354    unlock_futex(&rw->spin);
2355    return err;
2356  }
2357 
2358  if (rw->state == 0) {
2359    if (rw->blocked_writers) {
2360      ++rw->writer_signal;
2361      unlock_futex(&rw->spin);
2362      futex_wake(&rw->writer_signal,1);
2363      return 0;
2364    }
2365    if (rw->blocked_readers) {
2366      ++rw->reader_signal;
2367      unlock_futex(&rw->spin);
2368      futex_wake(&rw->reader_signal, INT_MAX);
2369      return 0;
2370    }
2371  }
2372  unlock_futex(&rw->spin);
2373  return 0;
2374}
2375#endif
2376
2377       
2378void
2379rwlock_destroy(rwlock *rw)
2380{
2381#ifndef USE_FUTEX
2382  destroy_semaphore((void **)&rw->reader_signal);
2383  destroy_semaphore((void **)&rw->writer_signal);
2384#endif
2385  postGCfree((void *)(rw->malloced_ptr));
2386}
2387
2388
2389
Note: See TracBrowser for help on using the repository browser.