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

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

Set tcr->shutdown_count to 1 in new_tcr() on Windows.
shutdown_thread_tcr(): use current tcr for locking (not necessarily the
tcr being shutdown.)
In windows kill_tcr(), have the caller call shutdown_thread_tcr(), unless
and until we can force the target to clean up after itself.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 53.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->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#endif
1288    UNLOCK(lisp_global(TCR_AREA_LOCK),current);
1289    if (termination_semaphore) {
1290      SEM_RAISE(termination_semaphore);
1291    }
1292  } else {
1293    tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1294  }
1295}
1296
1297void
1298tcr_cleanup(void *arg)
1299{
1300  TCR *tcr = (TCR *)arg;
1301  area *a;
1302
1303  a = tcr->vs_area;
1304  if (a) {
1305    a->active = a->high;
1306  }
1307  a = tcr->ts_area;
1308  if (a) {
1309    a->active = a->high;
1310  }
1311  a = tcr->cs_area;
1312  if (a) {
1313    a->active = a->high;
1314  }
1315  tcr->valence = TCR_STATE_FOREIGN;
1316  tcr->shutdown_count = 1;
1317  shutdown_thread_tcr(tcr);
1318  tsd_set(lisp_global(TCR_KEY), NULL);
1319}
1320
1321void *
1322current_native_thread_id()
1323{
1324  return ((void *) (natural)
1325#ifdef LINUX
1326          getpid()
1327#endif
1328#ifdef DARWIN
1329          mach_thread_self()
1330#endif
1331#ifdef FREEBSD
1332          pthread_self()
1333#endif
1334#ifdef SOLARIS
1335          pthread_self()
1336#endif
1337#ifdef WINDOWS
1338          GetCurrentThreadId()
1339#endif
1340          );
1341}
1342
1343
1344void
1345thread_init_tcr(TCR *tcr, void *stack_base, natural stack_size)
1346{
1347  area *a, *register_cstack_holding_area_lock(BytePtr, natural);
1348
1349  tcr->osid = current_thread_osid();
1350  tcr->native_thread_id = current_native_thread_id();
1351  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1352  a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size);
1353  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
1354  tcr->cs_area = a;
1355  a->owner = tcr;
1356  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
1357    tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
1358  }
1359#ifdef LINUX
1360#ifdef PPC
1361#ifndef PPC64
1362  tcr->native_thread_info = current_r2;
1363#endif
1364#endif
1365#endif
1366  tcr->errno_loc = &errno;
1367  tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
1368#ifdef DARWIN
1369  extern Boolean use_mach_exception_handling;
1370  if (use_mach_exception_handling) {
1371    darwin_exception_init(tcr);
1372  }
1373#endif
1374#ifdef LINUX
1375  linux_exception_init(tcr);
1376#endif
1377#ifdef WINDOWS
1378  tcr->io_datum = (VOID *)CreateEvent(NULL, true, false, NULL);
1379#endif
1380  tcr->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
1381}
1382
1383/*
1384  Register the specified tcr as "belonging to" the current thread.
1385  Under Darwin, setup Mach exception handling for the thread.
1386  Install cleanup handlers for thread termination.
1387*/
1388void
1389register_thread_tcr(TCR *tcr)
1390{
1391  void *stack_base = NULL;
1392  natural stack_size = 0;
1393
1394  os_get_current_thread_stack_bounds(&stack_base, &stack_size);
1395  thread_init_tcr(tcr, stack_base, stack_size);
1396  enqueue_tcr(tcr);
1397}
1398
1399
1400 
1401 
1402#ifndef MAP_GROWSDOWN
1403#define MAP_GROWSDOWN 0
1404#endif
1405
1406Ptr
1407create_stack(natural size)
1408{
1409  Ptr p;
1410  size=align_to_power_of_2(size, log2_page_size);
1411  p = (Ptr) MapMemoryForStack((size_t)size);
1412  if (p != (Ptr)(-1)) {
1413    *((size_t *)p) = size;
1414    return p;
1415  }
1416  allocation_failure(true, size);
1417
1418}
1419
1420void *
1421allocate_stack(natural size)
1422{
1423  return create_stack(size);
1424}
1425
1426void
1427free_stack(void *s)
1428{
1429  size_t size = *((size_t *)s);
1430  UnMapMemory(s, size);
1431}
1432
1433Boolean threads_initialized = false;
1434
1435#ifndef USE_FUTEX
1436#ifdef WINDOWS
1437void
1438count_cpus()
1439{
1440  SYSTEM_INFO si;
1441
1442  GetSystemInfo(&si);
1443  if (si.dwNumberOfProcessors > 1) {
1444    spin_lock_tries = 1024;
1445  }
1446}
1447#else
1448void
1449count_cpus()
1450{
1451#ifdef DARWIN
1452  /* As of OSX 10.4, Darwin doesn't define _SC_NPROCESSORS_ONLN */
1453#include <mach/host_info.h>
1454
1455  struct host_basic_info info;
1456  mach_msg_type_number_t count = HOST_BASIC_INFO_COUNT;
1457 
1458  if (KERN_SUCCESS == host_info(mach_host_self(), HOST_BASIC_INFO,(host_info_t)(&info),&count)) {
1459    if (info.max_cpus > 1) {
1460      spin_lock_tries = 1024;
1461    }
1462  }
1463#else
1464  int n = sysconf(_SC_NPROCESSORS_ONLN);
1465 
1466  if (n > 1) {
1467    spin_lock_tries = 1024;
1468  }
1469#endif
1470}
1471#endif
1472#endif
1473
1474void
1475init_threads(void * stack_base, TCR *tcr)
1476{
1477  lisp_global(INITIAL_TCR) = (LispObj)ptr_to_lispobj(tcr);
1478#ifdef WINDOWS
1479  lisp_global(TCR_KEY) = TlsAlloc();
1480  pCancelIoEx = windows_find_symbol(NULL, "CancelIoEx");
1481#else
1482  pthread_key_create((pthread_key_t *)&(lisp_global(TCR_KEY)), shutdown_thread_tcr);
1483  thread_signal_setup();
1484#endif
1485 
1486#ifndef USE_FUTEX
1487  count_cpus();
1488#endif
1489  threads_initialized = true;
1490}
1491
1492
1493#ifdef WINDOWS
1494unsigned CALLBACK
1495#else
1496void *
1497#endif
1498lisp_thread_entry(void *param)
1499{
1500  thread_activation *activation = (thread_activation *)param;
1501  TCR *tcr = new_tcr(activation->vsize, activation->tsize);
1502#ifndef WINDOWS
1503  sigset_t mask, old_mask;
1504
1505  sigemptyset(&mask);
1506  pthread_sigmask(SIG_SETMASK, &mask, &old_mask);
1507#endif
1508
1509  register_thread_tcr(tcr);
1510
1511#ifndef WINDOWS
1512  pthread_cleanup_push(tcr_cleanup,(void *)tcr);
1513#endif
1514  tcr->vs_area->active -= node_size;
1515  *(--tcr->save_vsp) = lisp_nil;
1516  enable_fp_exceptions();
1517  SET_TCR_FLAG(tcr,TCR_FLAG_BIT_AWAITING_PRESET);
1518  activation->tcr = tcr;
1519  SEM_RAISE(activation->created);
1520  do {
1521    SEM_RAISE(tcr->reset_completion);
1522    SEM_WAIT_FOREVER(tcr->activate);
1523    /* Now go run some lisp code */
1524    start_lisp(TCR_TO_TSD(tcr),0);
1525  } while (tcr->flags & (1<<TCR_FLAG_BIT_AWAITING_PRESET));
1526#ifndef WINDOWS
1527  pthread_cleanup_pop(true);
1528#else
1529  tcr_cleanup(tcr);
1530#endif
1531#ifdef WINDOWS
1532  return 0;
1533#else
1534  return NULL;
1535#endif
1536}
1537
1538void *
1539xNewThread(natural control_stack_size,
1540           natural value_stack_size,
1541           natural temp_stack_size)
1542
1543{
1544  thread_activation activation;
1545
1546
1547  activation.tsize = temp_stack_size;
1548  activation.vsize = value_stack_size;
1549  activation.tcr = 0;
1550  activation.created = new_semaphore(0);
1551  if (create_system_thread(control_stack_size +(CSTACK_HARDPROT+CSTACK_SOFTPROT), 
1552                           NULL, 
1553                           lisp_thread_entry,
1554                           (void *) &activation)) {
1555   
1556    SEM_WAIT_FOREVER(activation.created);       /* Wait until thread's entered its initial function */
1557  }
1558  destroy_semaphore(&activation.created); 
1559  return TCR_TO_TSD(activation.tcr);
1560}
1561
1562Boolean
1563active_tcr_p(TCR *q)
1564{
1565  TCR *head = (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR)), *p = head;
1566 
1567  do {
1568    if (p == q) {
1569      return true;
1570    }
1571    p = p->next;
1572  } while (p != head);
1573  return false;
1574}
1575
1576#ifdef WINDOWS
1577OSErr
1578xDisposeThread(TCR *tcr)
1579{
1580  return 0;                     /* I don't think that this is ever called. */
1581}
1582#else
1583OSErr
1584xDisposeThread(TCR *tcr)
1585{
1586  if (tcr != (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR))) {
1587    if (active_tcr_p(tcr) && (tcr != get_tcr(false))) {
1588      pthread_cancel((pthread_t)(tcr->osid));
1589      return 0;
1590    }
1591  }
1592  return -50;
1593}
1594#endif
1595
1596OSErr
1597xYieldToThread(TCR *target)
1598{
1599  Bug(NULL, "xYieldToThread ?");
1600  return 0;
1601}
1602 
1603OSErr
1604xThreadCurrentStackSpace(TCR *tcr, unsigned *resultP)
1605{
1606  Bug(NULL, "xThreadCurrentStackSpace ?");
1607  return 0;
1608}
1609
1610
1611#ifdef WINDOWS
1612LispObj
1613create_system_thread(size_t stack_size,
1614                     void* stackaddr,
1615                     unsigned CALLBACK (*start_routine)(void *),
1616                     void* param)
1617{
1618  HANDLE thread_handle;
1619
1620  stack_size = ((stack_size+(((1<<16)-1)))&~((1<<16)-1));
1621
1622  thread_handle = (HANDLE)_beginthreadex(NULL, 
1623                                         0/*stack_size*/,
1624                                         start_routine,
1625                                         param,
1626                                         0, 
1627                                         NULL);
1628
1629  if (thread_handle == NULL) {
1630    wperror("CreateThread");
1631  }
1632  return (LispObj) ptr_to_lispobj(thread_handle);
1633}
1634#else
1635LispObj
1636create_system_thread(size_t stack_size,
1637                     void* stackaddr,
1638                     void* (*start_routine)(void *),
1639                     void* param)
1640{
1641  pthread_attr_t attr;
1642  pthread_t returned_thread = (pthread_t) 0;
1643
1644  pthread_attr_init(&attr);
1645  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); 
1646
1647  if (stack_size == MINIMAL_THREAD_STACK_SIZE) {
1648    stack_size = PTHREAD_STACK_MIN;
1649  }
1650
1651  stack_size = ensure_stack_limit(stack_size);
1652  if (stackaddr != NULL) {
1653    /* Size must have been specified.  Sort of makes sense ... */
1654#ifdef DARWIN
1655    Fatal("no pthread_attr_setsetstack. "," Which end of stack does address refer to?");
1656#else
1657    pthread_attr_setstack(&attr, stackaddr, stack_size);
1658#endif
1659  } else if (stack_size != DEFAULT_THREAD_STACK_SIZE) {
1660    pthread_attr_setstacksize(&attr,stack_size);
1661  }
1662
1663  /*
1664     I think that's just about enough ... create the thread.
1665  */
1666  pthread_create(&returned_thread, &attr, start_routine, param);
1667  pthread_attr_destroy(&attr);
1668  return (LispObj) ptr_to_lispobj(returned_thread);
1669}
1670#endif
1671
1672TCR *
1673get_tcr(Boolean create)
1674{
1675#ifdef HAVE_TLS
1676  TCR *current = current_tcr.linear;
1677#else
1678  void *tsd = (void *)tsd_get(lisp_global(TCR_KEY));
1679  TCR *current = (tsd == NULL) ? NULL : TCR_FROM_TSD(tsd);
1680#endif
1681
1682  if ((current == NULL) && create) {
1683    LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
1684      callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
1685    int i, nbindwords = 0;
1686    extern unsigned initial_stack_size;
1687   
1688    /* Make one. */
1689    current = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
1690    SET_TCR_FLAG(current,TCR_FLAG_BIT_FOREIGN);
1691    register_thread_tcr(current);
1692#ifdef DEBUG_TCR_CREATION
1693#ifndef WINDOWS
1694    fprintf(stderr, "\ncreating TCR for pthread 0x%x", pthread_self());
1695#endif
1696#endif
1697    current->vs_area->active -= node_size;
1698    *(--current->save_vsp) = lisp_nil;
1699#ifdef PPC
1700#define NSAVEREGS 8
1701#endif
1702#ifdef X8664
1703#define NSAVEREGS 4
1704#endif
1705#ifdef X8632
1706#define NSAVEREGS 0
1707#endif
1708    for (i = 0; i < NSAVEREGS; i++) {
1709      *(--current->save_vsp) = 0;
1710      current->vs_area->active -= node_size;
1711    }
1712    nbindwords = ((int (*)())ptr_from_lispobj(callback_ptr))(-1);
1713    for (i = 0; i < nbindwords; i++) {
1714      *(--current->save_vsp) = 0;
1715      current->vs_area->active -= node_size;
1716    }
1717    current->shutdown_count = 1;
1718    ((void (*)())ptr_from_lispobj(callback_ptr))(0);
1719
1720  }
1721 
1722  return current;
1723}
1724
1725#ifdef WINDOWS
1726
1727Boolean
1728suspend_tcr(TCR *tcr)
1729{
1730  int suspend_count = atomic_incf(&(tcr->suspend_count));
1731  DWORD rc;
1732  if (suspend_count == 1) {
1733    /* Can't seem to get gcc to align a CONTEXT structure correctly */
1734    char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
1735
1736    CONTEXT *suspend_context, *pcontext;
1737    HANDLE hthread = (HANDLE)(tcr->osid);
1738    pc where;
1739    area *cs = tcr->cs_area;
1740    LispObj foreign_rsp;
1741
1742    pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
1743
1744    rc = SuspendThread(hthread);
1745    if (rc == -1) {
1746      /* If the thread's simply dead, we should handle that here */
1747      return false;
1748    }
1749    pcontext->ContextFlags = CONTEXT_ALL;
1750    rc = GetThreadContext(hthread, pcontext);
1751    if (rc == 0) {
1752      return false;
1753    }
1754    where = (pc)(xpPC(pcontext));
1755
1756    if (tcr->valence == TCR_STATE_LISP) {
1757      if ((where >= restore_windows_context_start) &&
1758          (where < restore_windows_context_end)) {
1759        /* Thread has started to return from an exception. */
1760        if (where < restore_windows_context_load_rcx) {
1761          /* In the process of restoring registers; context still in
1762             %rcx.  Just make our suspend_context be the context
1763             we're trying to restore, so that we'll resume from
1764             the suspend in the same context that we're trying to
1765             restore */
1766#ifdef WIN_64
1767          *pcontext = * (CONTEXT *)(pcontext->Rcx);
1768#else
1769          fprintf(stderr, "missing win32 suspend code, case (1)\n");
1770#endif
1771        } else {
1772          /* Most of the context has already been restored; fix %rcx
1773             if need be, then restore ss:rsp, cs:rip, and flags. */
1774#ifdef WIN64
1775          x64_iret_frame *iret_frame = (x64_iret_frame *) (pcontext->Rsp);
1776          if (where == restore_windows_context_load_rcx) {
1777            pcontext->Rcx = ((CONTEXT*)(pcontext->Rcx))->Rcx;
1778          }
1779          pcontext->Rip = iret_frame->Rip;
1780          pcontext->SegCs = (WORD) iret_frame->Cs;
1781          pcontext->EFlags = (DWORD) iret_frame->Rflags;
1782          pcontext->Rsp = iret_frame->Rsp;
1783          pcontext->SegSs = (WORD) iret_frame->Ss;
1784#else
1785#warning need context setup for win32
1786          fprintf(stderr, "missing win32 suspend code, case (2)\n");
1787#endif
1788        }
1789        tcr->suspend_context = NULL;
1790      } else {
1791        area *ts = tcr->ts_area;
1792        /* If we're in the lisp heap, or in x86-spentry64.o, or in
1793           x86-subprims64.o, or in the subprims jump table at #x15000,
1794           or on the tstack ... we're just executing lisp code.  Otherwise,
1795           we got an exception while executing lisp code, but haven't
1796           entered the handler yet (still in Windows exception glue
1797           or switching stacks or something.)  In the latter case, we
1798           basically want to get to he handler and have it notice
1799           the pending exception request, and suspend the thread at that
1800           point. */
1801        if (!((where < (pc)lisp_global(HEAP_END)) &&
1802              (where >= (pc)lisp_global(HEAP_START))) &&
1803            !((where < spentry_end) && (where >= spentry_start)) &&
1804            !((where < subprims_end) && (where >= subprims_start)) &&
1805            !((where < (pc) 0x16000) &&
1806              (where >= (pc) 0x15000)) &&
1807            !((where < (pc) (ts->high)) &&
1808              (where >= (pc) (ts->low)))) {
1809          /* The thread has lisp valence, but is not executing code
1810             where we expect lisp code to be and is not exiting from
1811             an exception handler.  That pretty much means that it's
1812             on its way into an exception handler; we have to handshake
1813             until it enters an exception-wait state. */
1814          /* There are likely race conditions here */
1815          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
1816          ResumeThread(hthread);
1817          SEM_WAIT_FOREVER(tcr->suspend);
1818          SuspendThread(hthread);
1819          /* The thread is either waiting for its resume semaphore to
1820             be signaled or is about to wait.  Signal it now, while
1821             the thread's suspended. */
1822          SEM_RAISE(tcr->resume);
1823          pcontext->ContextFlags = CONTEXT_ALL;
1824          GetThreadContext(hthread, pcontext);
1825        }
1826      }
1827    } else {
1828      if (tcr->valence == TCR_STATE_EXCEPTION_RETURN) {
1829        *pcontext = *tcr->pending_exception_context;
1830        tcr->pending_exception_context = NULL;
1831        tcr->valence = TCR_STATE_LISP;
1832      }
1833    }
1834
1835    /* If the context's stack pointer is pointing into the cs_area,
1836       copy the context below the stack pointer. else copy it
1837       below tcr->foreign_rsp. */
1838    foreign_rsp = xpGPR(pcontext,Isp);
1839
1840    if ((foreign_rsp < (LispObj)(cs->low)) ||
1841        (foreign_rsp >= (LispObj)(cs->high))) {
1842      foreign_rsp = (LispObj)(tcr->foreign_sp);
1843    }
1844    foreign_rsp -= 0x200;
1845    foreign_rsp &= ~15;
1846    suspend_context = (CONTEXT *)(foreign_rsp)-1;
1847    *suspend_context = *pcontext;
1848    tcr->suspend_context = suspend_context;
1849    return true;
1850  }
1851  return false;
1852}
1853#else
1854Boolean
1855suspend_tcr(TCR *tcr)
1856{
1857  int suspend_count = atomic_incf(&(tcr->suspend_count));
1858  pthread_t thread;
1859  if (suspend_count == 1) {
1860    thread = (pthread_t)(tcr->osid);
1861    if ((thread != (pthread_t) 0) &&
1862        (pthread_kill(thread, thread_suspend_signal) == 0)) {
1863      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1864    } else {
1865      /* A problem using pthread_kill.  On Darwin, this can happen
1866         if the thread has had its signal mask surgically removed
1867         by pthread_exit.  If the native (Mach) thread can be suspended,
1868         do that and return true; otherwise, flag the tcr as belonging
1869         to a dead thread by setting tcr->osid to 0.
1870      */
1871      tcr->osid = 0;
1872      return false;
1873    }
1874    return true;
1875  }
1876  return false;
1877}
1878#endif
1879
1880#ifdef WINDOWS
1881Boolean
1882tcr_suspend_ack(TCR *tcr)
1883{
1884  return true;
1885}
1886#else
1887Boolean
1888tcr_suspend_ack(TCR *tcr)
1889{
1890  if (tcr->flags & (1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING)) {
1891    SEM_WAIT_FOREVER(tcr->suspend);
1892    tcr->flags &= ~(1<<TCR_FLAG_BIT_SUSPEND_ACK_PENDING);
1893  }
1894  return true;
1895}
1896#endif
1897     
1898
1899Boolean
1900kill_tcr(TCR *tcr)
1901{
1902  TCR *current = get_tcr(true);
1903  Boolean result = false;
1904
1905  LOCK(lisp_global(TCR_AREA_LOCK),current);
1906  {
1907    LispObj osid = tcr->osid;
1908   
1909    if (osid) {
1910      result = true;
1911#ifdef WINDOWS
1912      /* What we really want to de hear is (something like)
1913         forcing the thread to run quit_handler().  For now,
1914         mark the TCR as dead and kill thw Windows thread. */
1915      tcr->osid = 0;
1916      if (!TerminateThread((HANDLE)osid, 0)) {
1917        result = false;
1918      } else {
1919        shutdown_thread_tcr(tcr);
1920      }
1921#else
1922      if (pthread_kill((pthread_t)osid,SIGQUIT)) {
1923        result = false;
1924      }
1925#endif
1926    }
1927  }
1928  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
1929  return result;
1930}
1931
1932Boolean
1933lisp_suspend_tcr(TCR *tcr)
1934{
1935  Boolean suspended;
1936  TCR *current = get_tcr(true);
1937 
1938  LOCK(lisp_global(TCR_AREA_LOCK),current);
1939  suspended = suspend_tcr(tcr);
1940  if (suspended) {
1941    while (!tcr_suspend_ack(tcr));
1942  }
1943  UNLOCK(lisp_global(TCR_AREA_LOCK),current);
1944  return suspended;
1945}
1946         
1947#ifdef WINDOWS
1948Boolean
1949resume_tcr(TCR *tcr)
1950{
1951  int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
1952  DWORD rc;
1953  if (suspend_count == 0) {
1954    CONTEXT *context = tcr->suspend_context;
1955    HANDLE hthread = (HANDLE)(tcr->osid);
1956
1957    if (context) {
1958      tcr->suspend_context = NULL;
1959      SetThreadContext(hthread,context);
1960      rc = ResumeThread(hthread);
1961      if (rc == -1) {
1962        wperror("ResumeThread");
1963        return false;
1964      }
1965      return true;
1966    }
1967  }
1968  return false;
1969}   
1970#else
1971Boolean
1972resume_tcr(TCR *tcr)
1973{
1974  int suspend_count = atomic_decf(&(tcr->suspend_count));
1975  if (suspend_count == 0) {
1976    void *s = (tcr->resume);
1977    if (s != NULL) {
1978      SEM_RAISE(s);
1979      return true;
1980    }
1981  }
1982  return false;
1983}
1984#endif
1985
1986   
1987
1988
1989Boolean
1990lisp_resume_tcr(TCR *tcr)
1991{
1992  Boolean resumed;
1993  TCR *current = get_tcr(true);
1994 
1995  LOCK(lisp_global(TCR_AREA_LOCK),current);
1996  resumed = resume_tcr(tcr);
1997  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
1998  return resumed;
1999}
2000
2001
2002TCR *freed_tcrs = NULL;
2003
2004void
2005enqueue_freed_tcr (TCR *tcr)
2006{
2007#ifndef HAVE_TLS
2008  tcr->next = freed_tcrs;
2009  freed_tcrs = tcr;
2010#endif
2011}
2012
2013/* It's not clear that we can safely condemn a dead tcr's areas, since
2014   we may not be able to call free() if a suspended thread owns a
2015   malloc lock. At least make the areas appear to be empty.
2016*/
2017   
2018
2019void
2020normalize_dead_tcr_areas(TCR *tcr)
2021{
2022  area *a;
2023
2024  a = tcr->vs_area;
2025  if (a) {
2026    a->active = a->high;
2027  }
2028
2029  a = tcr->ts_area;
2030  if (a) {
2031    a->active = a->high;
2032  }
2033
2034  a = tcr->cs_area;
2035  if (a) {
2036    a->active = a->high;
2037  }
2038}
2039   
2040void
2041free_freed_tcrs ()
2042{
2043  TCR *current, *next;
2044
2045  for (current = freed_tcrs; current; current = next) {
2046    next = current->next;
2047#ifndef HAVE_TLS
2048#ifdef WIN32
2049    free(current->allocated);
2050#else
2051    free(current);
2052#endif
2053#endif
2054  }
2055  freed_tcrs = NULL;
2056}
2057
2058void
2059suspend_other_threads(Boolean for_gc)
2060{
2061  TCR *current = get_tcr(true), *other, *next;
2062  int dead_tcr_count = 0;
2063  Boolean all_acked;
2064
2065  LOCK(lisp_global(TCR_AREA_LOCK), current);
2066  for (other = current->next; other != current; other = other->next) {
2067    if ((other->osid != 0)) {
2068      suspend_tcr(other);
2069      if (other->osid == 0) {
2070        dead_tcr_count++;
2071      }
2072    } else {
2073      dead_tcr_count++;
2074    }
2075  }
2076
2077  do {
2078    all_acked = true;
2079    for (other = current->next; other != current; other = other->next) {
2080      if ((other->osid != 0)) {
2081        if (!tcr_suspend_ack(other)) {
2082          all_acked = false;
2083        }
2084      }
2085    }
2086  } while(! all_acked);
2087
2088     
2089
2090  /* All other threads are suspended; can safely delete dead tcrs now */
2091  if (dead_tcr_count) {
2092    for (other = current->next; other != current; other = next) {
2093      next = other->next;
2094      if ((other->osid == 0))  {
2095        normalize_dead_tcr_areas(other);
2096        dequeue_tcr(other);
2097        enqueue_freed_tcr(other);
2098      }
2099    }
2100  }
2101}
2102
2103void
2104lisp_suspend_other_threads()
2105{
2106  suspend_other_threads(false);
2107}
2108
2109void
2110resume_other_threads(Boolean for_gc)
2111{
2112  TCR *current = get_tcr(true), *other;
2113  for (other = current->next; other != current; other = other->next) {
2114    if ((other->osid != 0)) {
2115      resume_tcr(other);
2116    }
2117  }
2118  free_freed_tcrs();
2119  UNLOCK(lisp_global(TCR_AREA_LOCK), current);
2120}
2121
2122void
2123lisp_resume_other_threads()
2124{
2125  resume_other_threads(false);
2126}
2127
2128
2129
2130rwlock *
2131rwlock_new()
2132{
2133  extern int cache_block_size;
2134
2135  void *p = calloc(1,sizeof(rwlock)+cache_block_size-1);
2136  rwlock *rw = NULL;;
2137 
2138  if (p) {
2139    rw = (rwlock *) ((((natural)p)+cache_block_size-1) & (~(cache_block_size-1)));
2140    rw->malloced_ptr = p;
2141#ifndef USE_FUTEX
2142    rw->reader_signal = new_semaphore(0);
2143    rw->writer_signal = new_semaphore(0);
2144    if ((rw->reader_signal == NULL) || (rw->writer_signal == NULL)) {
2145      if (rw->reader_signal) {
2146        destroy_semaphore(&(rw->reader_signal));
2147      } else {
2148        destroy_semaphore(&(rw->writer_signal));
2149      }
2150      free(rw);
2151      rw = NULL;
2152    }
2153#endif
2154  }
2155  return rw;
2156}
2157
2158     
2159/*
2160  Try to get read access to a multiple-readers/single-writer lock.  If
2161  we already have read access, return success (indicating that the
2162  lock is held another time.  If we already have write access to the
2163  lock ... that won't work; return EDEADLK.  Wait until no other
2164  thread has or is waiting for write access, then indicate that we
2165  hold read access once.
2166*/
2167#ifndef USE_FUTEX
2168int
2169rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2170{
2171  int err = 0;
2172 
2173  LOCK_SPINLOCK(rw->spin, tcr);
2174
2175  if (rw->writer == tcr) {
2176    RELEASE_SPINLOCK(rw->spin);
2177    return EDEADLK;
2178  }
2179
2180  while (rw->blocked_writers || (rw->state > 0)) {
2181    rw->blocked_readers++;
2182    RELEASE_SPINLOCK(rw->spin);
2183    err = semaphore_maybe_timedwait(rw->reader_signal,waitfor);
2184    LOCK_SPINLOCK(rw->spin,tcr);
2185    rw->blocked_readers--;
2186    if (err == EINTR) {
2187      err = 0;
2188    }
2189    if (err) {
2190      RELEASE_SPINLOCK(rw->spin);
2191      return err;
2192    }
2193  }
2194  rw->state--;
2195  RELEASE_SPINLOCK(rw->spin);
2196  return err;
2197}
2198#else
2199int
2200rwlock_rlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2201{
2202  natural waitval;
2203
2204  lock_futex(&rw->spin);
2205
2206  if (rw->writer == tcr) {
2207    unlock_futex(&rw->spin);
2208    return EDEADLOCK;
2209  }
2210  while (1) {
2211    if (rw->writer == NULL) {
2212      --rw->state;
2213      unlock_futex(&rw->spin);
2214      return 0;
2215    }
2216    rw->blocked_readers++;
2217    waitval = rw->reader_signal;
2218    unlock_futex(&rw->spin);
2219    futex_wait(&rw->reader_signal,waitval);
2220    lock_futex(&rw->spin);
2221    rw->blocked_readers--;
2222  }
2223  return 0;
2224}
2225#endif   
2226
2227
2228/*
2229  Try to obtain write access to the lock.
2230  It is an error if we already have read access, but it's hard to
2231  detect that.
2232  If we already have write access, increment the count that indicates
2233  that.
2234  Otherwise, wait until the lock is not held for reading or writing,
2235  then assert write access.
2236*/
2237
2238#ifndef USE_FUTEX
2239int
2240rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2241{
2242  int err = 0;
2243
2244  LOCK_SPINLOCK(rw->spin,tcr);
2245  if (rw->writer == tcr) {
2246    rw->state++;
2247    RELEASE_SPINLOCK(rw->spin);
2248    return 0;
2249  }
2250
2251  while (rw->state != 0) {
2252    rw->blocked_writers++;
2253    RELEASE_SPINLOCK(rw->spin);
2254    err = semaphore_maybe_timedwait(rw->writer_signal, waitfor);
2255    LOCK_SPINLOCK(rw->spin,tcr);
2256    rw->blocked_writers--;
2257    if (err == EINTR) {
2258      err = 0;
2259    }
2260    if (err) {
2261      RELEASE_SPINLOCK(rw->spin);
2262      return err;
2263    }
2264  }
2265  rw->state = 1;
2266  rw->writer = tcr;
2267  RELEASE_SPINLOCK(rw->spin);
2268  return err;
2269}
2270
2271#else
2272int
2273rwlock_wlock(rwlock *rw, TCR *tcr, struct timespec *waitfor)
2274{
2275  int err = 0;
2276  natural waitval;
2277
2278  lock_futex(&rw->spin);
2279  if (rw->writer == tcr) {
2280    rw->state++;
2281    unlock_futex(&rw->spin);
2282    return 0;
2283  }
2284
2285  while (rw->state != 0) {
2286    rw->blocked_writers++;
2287    waitval = rw->writer_signal;
2288    unlock_futex(&rw->spin);
2289    futex_wait(&rw->writer_signal,waitval);
2290    lock_futex(&rw->spin);
2291    rw->blocked_writers--;
2292  }
2293  rw->state = 1;
2294  rw->writer = tcr;
2295  unlock_futex(&rw->spin);
2296  return err;
2297}
2298#endif
2299
2300/*
2301  Sort of the same as above, only return EBUSY if we'd have to wait.
2302*/
2303#ifndef USE_FUTEX
2304int
2305rwlock_try_wlock(rwlock *rw, TCR *tcr)
2306{
2307  int ret = EBUSY;
2308
2309  LOCK_SPINLOCK(rw->spin,tcr);
2310  if (rw->writer == tcr) {
2311    rw->state++;
2312    ret = 0;
2313  } else {
2314    if (rw->state == 0) {
2315      rw->writer = tcr;
2316      rw->state = 1;
2317      ret = 0;
2318    }
2319  }
2320  RELEASE_SPINLOCK(rw->spin);
2321  return ret;
2322}
2323#else
2324int
2325rwlock_try_wlock(rwlock *rw, TCR *tcr)
2326{
2327  int ret = EBUSY;
2328
2329  lock_futex(&rw->spin);
2330  if (rw->writer == tcr) {
2331    rw->state++;
2332    ret = 0;
2333  } else {
2334    if (rw->state == 0) {
2335      rw->writer = tcr;
2336      rw->state = 1;
2337      ret = 0;
2338    }
2339  }
2340  unlock_futex(&rw->spin);
2341  return ret;
2342}
2343#endif
2344
2345#ifndef USE_FUTEX
2346int
2347rwlock_try_rlock(rwlock *rw, TCR *tcr)
2348{
2349  int ret = EBUSY;
2350
2351  LOCK_SPINLOCK(rw->spin,tcr);
2352  if (rw->state <= 0) {
2353    --rw->state;
2354    ret = 0;
2355  }
2356  RELEASE_SPINLOCK(rw->spin);
2357  return ret;
2358}
2359#else
2360int
2361rwlock_try_rlock(rwlock *rw, TCR *tcr)
2362{
2363  int ret = EBUSY;
2364
2365  lock_futex(&rw->spin);
2366  if (rw->state <= 0) {
2367    --rw->state;
2368    ret = 0;
2369  }
2370  unlock_futex(&rw->spin);
2371  return ret;
2372}
2373#endif
2374
2375
2376
2377#ifndef USE_FUTEX
2378int
2379rwlock_unlock(rwlock *rw, TCR *tcr)
2380{
2381
2382  int err = 0;
2383  natural blocked_readers = 0;
2384
2385  LOCK_SPINLOCK(rw->spin,tcr);
2386  if (rw->state > 0) {
2387    if (rw->writer != tcr) {
2388      err = EINVAL;
2389    } else {
2390      --rw->state;
2391      if (rw->state == 0) {
2392        rw->writer = NULL;
2393      }
2394    }
2395  } else {
2396    if (rw->state < 0) {
2397      ++rw->state;
2398    } else {
2399      err = EINVAL;
2400    }
2401  }
2402  if (err) {
2403    RELEASE_SPINLOCK(rw->spin);
2404    return err;
2405  }
2406 
2407  if (rw->state == 0) {
2408    if (rw->blocked_writers) {
2409      SEM_RAISE(rw->writer_signal);
2410    } else {
2411      blocked_readers = rw->blocked_readers;
2412      if (blocked_readers) {
2413        SEM_BROADCAST(rw->reader_signal, blocked_readers);
2414      }
2415    }
2416  }
2417  RELEASE_SPINLOCK(rw->spin);
2418  return 0;
2419}
2420#else
2421int
2422rwlock_unlock(rwlock *rw, TCR *tcr)
2423{
2424
2425  int err = 0;
2426
2427  lock_futex(&rw->spin);
2428  if (rw->state > 0) {
2429    if (rw->writer != tcr) {
2430      err = EINVAL;
2431    } else {
2432      --rw->state;
2433      if (rw->state == 0) {
2434        rw->writer = NULL;
2435      }
2436    }
2437  } else {
2438    if (rw->state < 0) {
2439      ++rw->state;
2440    } else {
2441      err = EINVAL;
2442    }
2443  }
2444  if (err) {
2445    unlock_futex(&rw->spin);
2446    return err;
2447  }
2448 
2449  if (rw->state == 0) {
2450    if (rw->blocked_writers) {
2451      ++rw->writer_signal;
2452      unlock_futex(&rw->spin);
2453      futex_wake(&rw->writer_signal,1);
2454      return 0;
2455    }
2456    if (rw->blocked_readers) {
2457      ++rw->reader_signal;
2458      unlock_futex(&rw->spin);
2459      futex_wake(&rw->reader_signal, INT_MAX);
2460      return 0;
2461    }
2462  }
2463  unlock_futex(&rw->spin);
2464  return 0;
2465}
2466#endif
2467
2468       
2469void
2470rwlock_destroy(rwlock *rw)
2471{
2472#ifndef USE_FUTEX
2473  destroy_semaphore((void **)&rw->reader_signal);
2474  destroy_semaphore((void **)&rw->writer_signal);
2475#endif
2476  postGCfree((void *)(rw->malloced_ptr));
2477}
2478
2479
2480
Note: See TracBrowser for help on using the repository browser.