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

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

free_tcr_extra_segment() for win32.

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