source: branches/working-0711/ccl/lisp-kernel/thread_manager.c @ 11089

Last change on this file since 11089 was 11089, checked in by gz, 13 years ago

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

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