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

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

Need a cast to pthread_t in kill_tcr().

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