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

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

Work around win32 malloc alignment limitations when allocating tcr
using tcr.allocated.

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