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

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

#include <sys/syscall.h> on Linux. use gettid() (which is only
available via syscall) for get_current_native_thread_id() on Linux.
(These thread IDs are what're used by GDB's 'info threads' command;
they're pid's from the linux kernel's perspective, but threads within
a process all see the same value returned by getpid() in modern Linux.)
Fall back to getpid() if the syscall isn't defined, but I'm not sure
that we can run on something so old that the syscall wouldn't be defined.

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