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

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

In 32-bit x86 FreeBSD setup_tcr_extra_segment(), exit (don't just perror)
if i386_set_ldt() call fails, as it seems to when run on a 64-bit 6.3
system.

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