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

Last change on this file since 11328 was 11328, checked in by gb, 11 years ago

In setup_tcr_extra_segment() for X8632 FreeBSD: helps to set sd.sd_hibase,
too.

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