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

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

In Solaris x8632 version of setup_tcr_extra_segment(), loop until
we find an LDT entry that's free and that we can successfully
allocate (Solaris seems to use or disallow allocation of the first
6 entries by my count.) Mark those entries that can't be allocated
as "in use" in the bitvector.

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