/*
* File: posix-threads.c
* Author: Keith Dennison
* Copyright (c) 1999 Functional Objects, Inc. All rights reserved.
*
* A description of the implementation of the primitives in this file can be
* found in D-doc-design-runtime!win32-thread-portability.text
*/
#define THREADS_RUN_TIME_LIB
#define USE_STDIO_H
#include "posix-threads.h"
#include <assert.h>
#include <stddef.h>
#include <stdlib.h>
#include <pthread.h>
#include <time.h>
#include <gc/gc.h>
/*****************************************************************************/
/* GLOBAL VARIABLE DECLARATIONS */
/* */
/* There is an implementation constraint that other parts of the Dylan */
/* runtime system must ensure that TLV vectors are static (by referencing */
/* them from ambiguous roots). Hence they may also be referenced from C data */
/* structures. The variable default_tlv_vector is now defined externally */
/* so that it can be an ambiguous root. */
/* */
/*****************************************************************************/
extern OBJECT KPfalseVKi;
pthread_mutex_t thread_join_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t thread_exit_event = PTHREAD_COND_INITIALIZER;
pthread_key_t thread_key;
pthread_key_t thread_handle_key;
pthread_key_t tlv_vector_key;
pthread_mutex_t tlv_vector_lock = PTHREAD_MUTEX_INITIALIZER;
TLV_VECTOR default_tlv_vector = NULL;
pthread_mutex_t tlv_vector_list_lock;
TLV_VECTOR_LIST tlv_vector_list;
int TLV_vector_offset = 2;
/*****************************************************************************/
/* LOCAL FUNCTION DECLARATIONS */
/*****************************************************************************/
void initialize_threads_primitives();
void *make_dylan_vector(int);
int priority_map(int);
void *get_tlv_vector();
void set_tlv_vector(void *);
TLV_VECTOR grow_tlv_vector(TLV_VECTOR vector, int newsize);
void grow_all_tlv_vectors(int newsize);
void copy_tlv_vector(TLV_VECTOR destination, TLV_VECTOR source);
void update_tlv_vectors(int offset, D value);
void add_tlv_vector(DTHREAD *thread, TLV_VECTOR tlv_vector);
int remove_tlv_vector(DTHREAD *thread);
void initialize_threads_primitives()
{
MSG0("Initializing threads primitives\n");
default_tlv_vector = make_dylan_vector(TLV_VECTOR_INITIAL_SIZE);
pthread_key_create(&thread_key, NULL);
pthread_key_create(&thread_handle_key, NULL);
pthread_key_create(&tlv_vector_key, NULL);
}
void *make_dylan_vector(int n)
{
D *vector;
vector = malloc((n + 2) * sizeof(D));
vector[0] = NULL;
vector[1] = I(n);
return vector;
}
void *get_tlv_vector()
{
return pthread_getspecific(tlv_vector_key);
}
void set_tlv_vector(void *vector)
{
pthread_setspecific(tlv_vector_key, vector);
}
void *get_current_thread()
{
return pthread_getspecific(thread_key);
}
void set_current_thread(void *thread)
{
pthread_setspecific(thread_key, thread);
}
void *get_current_thread_handle()
{
return pthread_getspecific(thread_handle_key);
}
void set_current_thread_handle(void *handle)
{
pthread_setspecific(thread_handle_key, handle);
}
/* Grow a single TLV vector
*/
TLV_VECTOR grow_tlv_vector(TLV_VECTOR vector, int newsize)
{
TLV_VECTOR new_vector;
// allocate a new vector and copy the values in the old across
new_vector = make_dylan_vector(newsize);
copy_tlv_vector(new_vector, vector);
// return the new vector
return(new_vector);
}
void grow_all_tlv_vectors(newsize)
{
TLV_VECTOR_LIST list;
TLV_VECTOR new_default;
// Grow the default vector
new_default = make_dylan_vector(newsize);
copy_tlv_vector(new_default, default_tlv_vector);
default_tlv_vector = new_default;
// Grow each vector in the active thread list
list = tlv_vector_list;
while(list != NULL) {
list->tlv_vector = grow_tlv_vector(list->tlv_vector, newsize);
list = list->next;
}
}
/* Copy a tlv vector. Assumes the destination vector is at least as large
* as the source vector.
*/
void copy_tlv_vector(TLV_VECTOR destination, TLV_VECTOR source)
{
int i, limit;
limit = ((int)(source[1]) >> 2) + 2;
for (i = 2; i<limit; i++)
destination[i] = source[i];
}
/* Add a new variable to all the TLV vectors in the active thread list.
* Assumes the vectors do not need to be grown. Also, the calling function
* must be in the tlv_vector_list_lock Critical Section.
*/
void
update_tlv_vectors(int offset, D value)
{
TLV_VECTOR_LIST list = tlv_vector_list;
D *destination;
while (list != NULL) {
destination = (D *)(list->tlv_vector + offset);
*destination = value;
list = list->next;
}
}
/* add_tlv_vector adds a new thread to the active thread vector list.
* Assumes the thread vector has already been initialised.
*/
void
add_tlv_vector(DTHREAD *thread, TLV_VECTOR tlv_vector)
{
TLV_VECTOR_LIST new_element = malloc(sizeof(struct tlv_vector_list_element));
assert(new_element != NULL);
// initialise the new element and put it on the front of the list
new_element->thread = thread;
new_element->tlv_vector = tlv_vector;
new_element->next = tlv_vector_list;
tlv_vector_list = new_element;
}
/* A thread calls remove_tlv_vector just before it terminates. The function
* removes the thread from the list of active threads.
*/
int
remove_tlv_vector(DTHREAD *thread)
{
TLV_VECTOR_LIST last, current;
if (tlv_vector_list == NULL) // empty list
return(1);
last = tlv_vector_list;
if (tlv_vector_list->thread == thread) {
// matches first entry in list
tlv_vector_list = tlv_vector_list->next;
free(last->tlv_vector);
free(last);
return(0);
}
current = tlv_vector_list->next;
while (current != NULL) {
if (current->thread == thread) {
// found the right entry, so cut it out
last->next = current->next;
free(current->tlv_vector);
free(current);
return(0);
}
else {
last = current;
current = current->next;
}
}
// Reached the end of the list without finding thread's entry
return(1);
}
/*****************************************************************************/
/* THREAD PRIMITIVES */
/*****************************************************************************/
void *trampoline (void *arg)
{
D result, f;
DTHREAD *thread = (DTHREAD *)arg;
assert(thread != NULL);
f = (D)(thread->handle2);
result = CALL0(f);
remove_tlv_vector(thread);
pthread_mutex_lock(&thread_join_lock);
thread->handle1 = (void *)((unsigned int)thread->handle1 | COMPLETED);
pthread_cond_broadcast(&thread_exit_event);
pthread_mutex_unlock(&thread_join_lock);
return result;
}
/* 1 */
D primitive_make_thread(D t, D n, D p, D f, DBOOL s)
{
DTHREAD *thread = (DTHREAD *)t;
D_NAME name = (D_NAME)n;
ZINT zpriority = (ZINT)p;
DBOOL synchronize = s;
pthread_attr_t attr;
struct sched_param param;
int priority = (int)zpriority >> 2;
assert(thread != NULL);
assert(IS_ZINT(zpriority));
assert(f != NULL);
thread->handle1 = 0;
thread->handle2 = f;
param.sched_priority = priority_map(priority);
if (pthread_attr_init(&attr)) {
MSG0("make-thread: error attr_init\n");
return CREATE_ERROR;
}
if (pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED)) {
MSG0("make-thread: error attr_setdetachstate\n");
return CREATE_ERROR;
}
// if (pthread_attr_setschedparam(&attr, ¶m)) {
// MSG0("make-thread: error set_schedparam\n");
// return CREATE_ERROR;
// }
if (pthread_create(&thread->tid, &attr, trampoline, thread)) {
MSG0("make-thread: error creating thread\n");
return CREATE_ERROR;
}
if (pthread_attr_destroy(&attr)) {
MSG0("make-thread: error destroy\n");
return CREATE_ERROR;
}
return OK;
}
/* 2 */
D primitive_destroy_thread(D t)
{
DTHREAD *thread = (DTHREAD *)t;
assert(thread != NULL);
return OK;
}
/* 3 */
D primitive_thread_join_single(D t)
{
DTHREAD *thread = t;
unsigned int state, completed;
assert(thread != NULL);
if (pthread_mutex_lock(&thread_join_lock) != 0) {
MSG0("thread-join-single: error obtaining thread join lock\n");
return GENERAL_ERROR;
}
state = (unsigned int)thread->handle1;
if (state & MARKED || state & JOINED) {
pthread_mutex_unlock(&thread_join_lock);
MSG0("thread-join-single: duplicate join error\n");
return GENERAL_ERROR;
}
thread->handle1 = (void *)(state | MARKED);
completed = state & COMPLETED;
while (!completed) {
if (pthread_cond_wait(&thread_exit_event, &thread_join_lock)) {
MSG0("thread-join-single: error waiting for thread exit event\n");
return GENERAL_ERROR;
}
completed = (unsigned int)thread->handle1 & COMPLETED;
}
thread->handle1 = (void *)((unsigned int)thread->handle1 ^ (JOINED | MARKED));
if (pthread_mutex_unlock(&thread_join_lock) != 0) {
MSG0("thread-join-single: error releasing thread join lock\n");
return GENERAL_ERROR;
}
return OK;
}
/* 4 */
D primitive_thread_join_multiple(D v)
{
SOV *thread_vector = v;
DTHREAD **threads, *joined_thread = NULL;
int i, result, size;
unsigned int state;
assert(thread_vector != NULL);
assert(IS_ZINT(thread_vector->size));
size = ((int)(thread_vector->size)) >> 2;
threads = (DTHREAD **)(thread_vector->data);
if (pthread_mutex_lock(&thread_join_lock)) {
}
/* Make sure none of the threads is already
* part of a join operation
*/
for (i = 0; i < size; i++) {
state = (unsigned int)threads[i]->handle1;
if (state & MARKED || state & JOINED) {
return GENERAL_ERROR;
}
}
/* Now mark the threads as being part of a join
*/
for (i = 0; i < size; i++) {
state = (unsigned int)threads[i]->handle1;
threads[i]->handle1 = (void *)(state | MARKED);
}
for (i = 0; i < size; i++) {
state = (unsigned int)threads[i]->handle1;
if (state & COMPLETED) {
joined_thread = threads[i];
break;
}
}
while (joined_thread == NULL) {
if (pthread_cond_wait(&thread_exit_event, &thread_join_lock)) {
MSG0("thread-join-single: error waiting for thread exit event\n");
return GENERAL_ERROR;
}
for (i = 0; i < size; i++) {
if ((unsigned int)threads[i]->handle1 & COMPLETED) {
joined_thread = threads[i];
break;
}
}
}
state = (unsigned int)joined_thread->handle1;
joined_thread->handle1 = (void *)(state | JOINED);
for (i = 0; i < size; i++) {
state = (unsigned int)threads[i]->handle1;
threads[i]->handle1 = (void *)(state ^ MARKED);
}
if (pthread_mutex_unlock(&thread_join_lock) != 0) {
MSG0("thread-join-single: error releasing thread join lock\n");
return GENERAL_ERROR;
}
return joined_thread;
}
/* 4.5 */
void primitive_detach_thread(D t)
{
DTHREAD* thread = t;
assert(thread != NULL);
pthread_detach(thread->tid);
}
/* 5 */
void primitive_thread_yield(void)
{
// Causes thread to give up its remaining time slice
sched_yield();
}
/* 6. */
D primitive_current_thread(void)
{
return get_current_thread();
}
/* 7 */
D primitive_wait_for_simple_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SIMPLELOCK *slock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
slock = lock->handle;
thread = pthread_self();
if (slock->owner == thread) {
MSG1("wait-for-simple-lock: Error, thread %d already owns the lock\n",
thread);
return ALREADY_LOCKED;
}
if (pthread_mutex_lock(&slock->mutex)) {
MSG0("wait-for-simple-lock: Error locking mutex\n");
return GENERAL_ERROR;
}
while (slock->owner != 0)
pthread_cond_wait(&slock->cond, &slock->mutex);
slock->owner = thread;
if (pthread_mutex_unlock(&slock->mutex)) {
MSG0("wait-for-simple-lock: Error unlocking mutex\n");
return GENERAL_ERROR;
}
return OK;
}
/* 8 */
D primitive_wait_for_recursive_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
RECURSIVELOCK *rlock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
rlock = lock->handle;
thread = pthread_self();
if (rlock->owner == thread) {
rlock->count++;
}
else {
pthread_mutex_lock(&rlock->mutex);
while(rlock->owner != 0)
pthread_cond_wait(&rlock->cond, &rlock->mutex);
rlock->owner = thread;
rlock->count = 1;
pthread_mutex_unlock(&rlock->mutex);
}
return OK;
}
/* 9 */
D primitive_wait_for_semaphore(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SEMAPHORE *semaphore;
assert(lock != NULL);
assert(lock->handle != NULL);
semaphore = lock->handle;
if (pthread_mutex_lock(&semaphore->mutex)) {
MSG0("wait-for-semaphore: pthread_mutex_lock returned error\n");
return GENERAL_ERROR;
}
while (semaphore->count <= 0) {
pthread_cond_wait(&semaphore->cond, &semaphore->mutex);
}
semaphore->count--;
if (pthread_mutex_unlock(&semaphore->mutex)) {
MSG0("wait-for-semaphore: pthread_mutex_unlock returned error\n");
return GENERAL_ERROR;
}
return OK;
}
/* 10 */
D primitive_wait_for_notification(D n, D l)
{
CONTAINER *notif = (CONTAINER *)n;
CONTAINER *lock = (CONTAINER *)l;
NOTIFICATION *notification;
SIMPLELOCK *slock;
int owned, error;
assert(notif != NULL);
assert(notif->handle != NULL);
assert(lock != NULL);
assert(lock->handle != NULL);
notification = notif->handle;
slock = lock->handle;
// make sure thread owns the simple lock
owned = (int)primitive_owned_simple_lock(lock) >> 2;
if (owned == 0) {
MSG0("wait-for-notification: Don't own associated lock\n");
return NOT_LOCKED;
}
if (pthread_mutex_lock(¬ification->mutex)
|| primitive_release_simple_lock(lock) != OK) {
MSG0("wait-for-notification: Error releasing associated lock");
return GENERAL_ERROR;
}
error = pthread_cond_wait(¬ification->cond, ¬ification->mutex);
if (primitive_wait_for_simple_lock(lock) != OK
|| pthread_mutex_unlock(¬ification->mutex)) {
MSG0("wait-for-notification: Error claiming associated lock");
return GENERAL_ERROR;
}
if (error) {
MSG0("wait-for-notification: error waiting for condition variable");
return GENERAL_ERROR;
}
return OK;
}
/* 11 */
D primitive_wait_for_simple_lock_timed(D l, D ms)
{
CONTAINER *lock = (CONTAINER *)l;
ZINT zmilsecs = (ZINT)ms;
SIMPLELOCK *slock;
pthread_t thread;
int timeout = 0;
long milsecs, secs;
struct timespec end;
assert(lock != NULL);
assert(lock->handle != NULL);
assert(IS_ZINT(zmilsecs));
slock = lock->handle;
thread = pthread_self();
if (slock->owner == thread) {
MSG0("wait-for-simple-lock-timed: Error. Already own the lock\n");
return ALREADY_LOCKED;
}
time(&end.tv_sec);
milsecs = zmilsecs >> 2;
secs = milsecs / 1000;
end.tv_sec += secs;
milsecs = milsecs % 1000;
end.tv_nsec = milsecs * 1000000L;
if (pthread_mutex_lock(&slock->mutex)) {
MSG0("wait-for-simple-lock-timed: Error locking mutex\n");
return GENERAL_ERROR;
}
while (slock->owner != 0 && !timeout)
timeout = pthread_cond_timedwait(&slock->cond, &slock->mutex, &end);
if (!timeout)
slock->owner = thread;
if (pthread_mutex_unlock(&slock->mutex)) {
MSG0("wait-for-simple-lock: Error unlocking mutex\n");
return GENERAL_ERROR;
}
return (timeout ? TIMEOUT : OK);
}
/* 12 */
D primitive_wait_for_recursive_lock_timed(D l, D ms)
{
CONTAINER *lock = (CONTAINER *)l;
ZINT zmilsecs = (ZINT)ms;
RECURSIVELOCK *rlock;
pthread_t thread;
int timeout = 0;
long milsecs, secs;
struct timespec end;
assert(lock != NULL);
assert(lock->handle != NULL);
assert(IS_ZINT(zmilsecs));
rlock = lock->handle;
thread = pthread_self();
if (rlock->owner == thread) {
rlock->count++;
return OK;
}
time(&end.tv_sec);
milsecs = zmilsecs >> 2;
secs = milsecs / 1000;
end.tv_sec += secs;
milsecs = milsecs % 1000;
end.tv_nsec = milsecs * 1000000L;
pthread_mutex_lock(&rlock->mutex);
while (rlock->owner != 0 && !timeout)
timeout = pthread_cond_timedwait(&rlock->cond, &rlock->mutex, &end);
if (!timeout) {
rlock->owner = thread;
rlock->count = 1;
}
if (pthread_mutex_unlock(&rlock->mutex)) {
MSG0("wait-for-recursive-lock-timed: Error unlocking mutex\n");
return GENERAL_ERROR;
}
return (timeout ? TIMEOUT : OK);
}
/* 13 */
D primitive_wait_for_semaphore_timed(D l, D m)
{
CONTAINER *lock = (CONTAINER *)l;
ZINT zmilsecs = (ZINT)m;
SEMAPHORE *semaphore;
int timeout = 0;
long milsecs, secs;
struct timespec time_limit;
assert(lock != NULL);
assert(lock->handle != NULL);
assert(IS_ZINT(zmilsecs));
time(&time_limit.tv_sec);
milsecs = zmilsecs >> 2;
secs = milsecs / 1000;
time_limit.tv_sec += secs;
milsecs = milsecs % 1000;
time_limit.tv_nsec = milsecs * 10;
semaphore = lock->handle;
if (pthread_mutex_lock(&semaphore->mutex)) {
MSG0("wait-for-semaphore: pthread_mutex_lock returned error\n");
return GENERAL_ERROR;
}
while (!timeout && semaphore->count <= 0) {
timeout = pthread_cond_timedwait(&semaphore->cond,
&semaphore->mutex,
&time_limit);
}
if (!timeout)
semaphore->count--;
if (pthread_mutex_unlock(&semaphore->mutex)) {
MSG0("wait-for-semaphore: pthread_mutex_unlock returned error\n");
return GENERAL_ERROR;
}
if (timeout)
return TIMEOUT;
else
return OK;
}
/* 14 */
D primitive_wait_for_notification_timed(D n, D l, D m)
{
CONTAINER *notif = (CONTAINER *)n;
CONTAINER *lock = (CONTAINER *)l;
ZINT zmilsecs = (ZINT)m;
DWORD start, current;
NOTIFICATION *notification;
SIMPLELOCK *slock;
int milsecs, secs, owned, timeout;
struct timespec limit;
assert(notif != NULL);
assert(notif->handle != NULL);
assert(lock != NULL);
assert(lock->handle != NULL);
assert(IS_ZINT(zmilsecs));
notification = notif->handle;
slock = lock->handle;
milsecs = zmilsecs >> 2;
time(&limit.tv_sec);
secs = milsecs / 1000;
limit.tv_sec += secs;
milsecs = milsecs % 1000;
limit.tv_nsec = milsecs * 1000000L;
owned = (int)primitive_owned_simple_lock(lock) >> 2;
if (owned == 0) {
MSG0("wait-for-notification-timed: Don't own associated lock\n");
return NOT_LOCKED;
}
pthread_mutex_lock(¬ification->mutex);
primitive_release_simple_lock(lock);
timeout = pthread_cond_timedwait(¬ification->cond, ¬ification->mutex, &limit);
primitive_wait_for_simple_lock(lock);
pthread_mutex_unlock(¬ification->mutex);
if (timeout) {
MSG0("wait-for-notification-timed: timeout\n");
return TIMEOUT;
}
return OK;
}
/* 15 */
D primitive_release_simple_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SIMPLELOCK *slock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
slock = lock->handle;
thread = pthread_self();
if (slock->owner != thread) {
MSG0("release-simple-lock: Error, don't own the lock\n");
return NOT_LOCKED;
}
slock->owner = 0;
if (pthread_mutex_lock(&slock->mutex)
|| pthread_cond_signal(&slock->cond)
|| pthread_mutex_unlock(&slock->mutex)) {
MSG0("release-simple-lock: error signalling cond\n");
return GENERAL_ERROR;
}
return OK;
}
/* 16 */
D primitive_release_recursive_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
RECURSIVELOCK *rlock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
rlock = lock->handle;
thread = pthread_self();
if (rlock->owner != thread) {
MSG0("release-recursive-lock: Error, don't own the lock\n");
return NOT_LOCKED;
}
rlock->count--;
if (rlock->count < 1) {
// Give up the lock
rlock->owner = 0;
if (pthread_mutex_lock(&rlock->mutex)
|| pthread_cond_signal(&rlock->cond)
|| pthread_mutex_unlock(&rlock->mutex)) {
MSG0("release-recursive-lock: error signalling cond\n");
return GENERAL_ERROR;
}
}
return OK;
}
/* 17 */
D primitive_release_semaphore(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SEMAPHORE *semaphore;
assert(lock != NULL);
assert(lock->handle != NULL);
semaphore = lock->handle;
if (pthread_mutex_lock(&semaphore->mutex)) {
MSG0("release-semaphore: pthread_mutex_lock returned error\n");
return GENERAL_ERROR;
}
if (semaphore->count >= semaphore->max_count) {
MSG0("release-semaphore: count exceeded\n");
return COUNT_EXCEEDED;
}
semaphore->count++;
if (pthread_mutex_unlock(&semaphore->mutex)
|| pthread_cond_signal(&semaphore->cond)) {
MSG0("release-semaphore: error releasing semaphore\n");
return GENERAL_ERROR;
}
return OK;
}
/* 18 */
D primitive_release_notification(D n, D l)
{
CONTAINER *notif = (CONTAINER *)n;
CONTAINER *lock = (CONTAINER *)l;
NOTIFICATION *notification;
SIMPLELOCK *slock;
int owned;
assert(notif != NULL);
assert(notif->handle != NULL);
assert(lock != NULL);
assert(lock->handle != NULL);
notification = notif->handle;
slock = lock->handle;
owned = (int)primitive_owned_simple_lock(lock) >> 2;
if (owned == 0) {
MSG0("release-notification: Don't own associated lock\n");
return NOT_LOCKED;
}
if (pthread_mutex_lock(¬ification->mutex)
|| pthread_cond_signal(¬ification->cond)
|| pthread_mutex_unlock(¬ification->mutex)) {
MSG0("release-notification: error signalling condition variable\n");
return GENERAL_ERROR;
}
return OK;
}
/* 19 */
D primitive_release_all_notification(D n, D l)
{
CONTAINER *notif = (CONTAINER *)n;
CONTAINER *lock = (CONTAINER *)l;
NOTIFICATION *notification;
SIMPLELOCK *slock;
int owned;
assert(notif != NULL);
assert(notif->handle != NULL);
assert(lock != NULL);
assert(lock->handle != NULL);
notification = notif->handle;
slock = lock->handle;
owned = (int)primitive_owned_simple_lock(lock) >> 2;
if (owned == 0) {
MSG0("release-all-notification: Don't own associated lock\n");
return NOT_LOCKED;
}
if (pthread_mutex_lock(¬ification->mutex)
|| pthread_cond_broadcast(¬ification->cond)
|| pthread_mutex_unlock(¬ification->mutex)) {
MSG0("release-all-notification: error broadcasting condition variable");
return GENERAL_ERROR;
}
return OK;
}
/* 20 */
D primitive_make_recursive_lock(D l, D n)
{
CONTAINER *lock = (CONTAINER *)l;
D_NAME name = (D_NAME)n;
RECURSIVELOCK *rlock;
assert(lock != NULL);
rlock = (RECURSIVELOCK *)malloc(sizeof(RECURSIVELOCK));
if (rlock == NULL) {
MSG0("make-recursive-lock: malloc failed\n");
return GENERAL_ERROR;
}
rlock->count = 0;
rlock->owner = 0;
if (pthread_mutex_init(&rlock->mutex, NULL)
|| pthread_cond_init(&rlock->cond, NULL)) {
MSG0("make-recursive-lock: error creating mutex\n");
free(rlock);
return GENERAL_ERROR;
}
lock->handle = rlock;
return OK;
}
/* 21 */
D primitive_destroy_recursive_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
RECURSIVELOCK *rlock;
assert(lock != NULL);
assert(lock->handle != NULL);
rlock = lock->handle;
if (pthread_mutex_destroy(&rlock->mutex)
|| pthread_cond_destroy(&rlock->cond)) {
MSG0("destroy-recursive-lock: error destroying mutex\n");
return GENERAL_ERROR;
}
free(rlock);
return OK;
}
/* 22 */
D primitive_make_simple_lock(D l, D n)
{
CONTAINER *lock = (CONTAINER *)l;
D_NAME name = (D_NAME)n;
SIMPLELOCK *slock;
assert(lock != NULL);
slock = (SIMPLELOCK *)malloc(sizeof(SIMPLELOCK));
if (slock == NULL) {
MSG0("make-simple-lock: malloc failed\n");
return GENERAL_ERROR;
}
if (pthread_mutex_init(&slock->mutex, NULL)
|| pthread_cond_init(&slock->cond, NULL)) {
MSG0("make-simple-lock: error creating mutex/cond\n");
free(slock);
return GENERAL_ERROR;
}
slock->owner = 0;
lock->handle = slock;
return OK;
}
/* 23 */
D primitive_destroy_simple_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SIMPLELOCK *slock;
assert(lock != NULL);
assert(lock->handle != NULL);
slock = lock->handle;
if (pthread_mutex_destroy(&slock->mutex)
|| pthread_cond_destroy(&slock->cond)) {
MSG0("destroy-simple-lock: pthread_mutex_destroy returned error\n");
return GENERAL_ERROR;
}
lock->handle = NULL;
free(slock);
return OK;
}
/* 24 */
D primitive_owned_simple_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SIMPLELOCK *slock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
slock = lock->handle;
thread = pthread_self();
if (slock->owner == thread)
return(I(1)); // owned
else
return(I(0)); // not owned
}
/* 25 */
D primitive_owned_recursive_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
RECURSIVELOCK *rlock;
pthread_t thread;
assert(lock != NULL);
assert(lock->handle != NULL);
rlock = lock->handle;
thread = pthread_self();
if (rlock->owner == thread)
return(I(1)); // owned
else
return(I(0)); // not owned
}
/* 26 */
D primitive_make_semaphore(D l, D n, D i, D m)
{
CONTAINER *lock = (CONTAINER *)l;
D_NAME name = (D_NAME)n;
ZINT zinitial = (ZINT)i;
ZINT zmax = (ZINT)m;
SEMAPHORE *semaphore;
int initial = zinitial >> 2;
int max = zmax >> 2;
assert(lock != NULL);
assert(IS_ZINT(zinitial));
assert(IS_ZINT(zmax));
semaphore = (SEMAPHORE *)malloc(sizeof(SEMAPHORE));
if (semaphore == NULL) {
MSG0("make-semaphore: malloc failed\n");
return GENERAL_ERROR;
}
if (pthread_mutex_init(&semaphore->mutex, NULL)
|| pthread_cond_init(&semaphore->cond, NULL)) {
MSG0("make-semaphore: error initializing OS objects\n");
free(semaphore);
return GENERAL_ERROR;
}
semaphore->count = initial;
semaphore->max_count = max;
lock->handle = semaphore;
return OK;
}
/* 27 */
D primitive_destroy_semaphore(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SEMAPHORE *semaphore;
assert(lock != NULL);
assert(lock->handle != NULL);
semaphore = lock->handle;
if (pthread_mutex_destroy(&semaphore->mutex)
|| pthread_cond_destroy(&semaphore->cond)) {
MSG0("destroy-semaphore: error destroying OS objects\n");
return GENERAL_ERROR;
}
free(semaphore);
return OK;
}
/* 28 */
D primitive_make_notification(D n, D s)
{
CONTAINER *notif = (CONTAINER *)n;
D_NAME name = (D_NAME)s;
NOTIFICATION *notification;
assert(notif != NULL);
notification = (NOTIFICATION *)malloc(sizeof(NOTIFICATION));
if (notification == NULL) {
MSG0("make-notification: malloc returned error\n");
return GENERAL_ERROR;
}
if (pthread_mutex_init(¬ification->mutex, NULL)
|| pthread_cond_init(¬ification->cond, NULL)) {
MSG0("make-notification: error creating condition variable\n");
free(notification);
return GENERAL_ERROR;
}
notif->handle = notification;
return OK;
}
/* 29 */
D primitive_destroy_notification(D n)
{
CONTAINER *notif;
NOTIFICATION *notification;
assert(notif != NULL);
assert(notif->handle != NULL);
notification = notif->handle;
if (pthread_mutex_destroy(¬ification->mutex)
|| pthread_cond_destroy(¬ification->cond)) {
MSG0("destroy-notification: error destroying condition variable\n");
return GENERAL_ERROR;
}
free(notification);
return OK;
}
/* 30 */
void primitive_sleep(D m)
{
ZINT zmilsecs = (ZINT)m;
DWORD milsecs = zmilsecs >> 2;
assert(IS_ZINT(zmilsecs));
sleep((milsecs + 999) / 1000);
}
/* 31 */
/*
Z
primitive_assign_atomic_memory(void * * location, Z newval)
{
}
*/
/* 32 */
/*
ZINT
primitive_conditional_update_memory(void * * location, Z newval, Z oldval)
{
}
*/
/* 33 */
D primitive_allocate_thread_variable(D v)
{
pthread_key_t key;
int variable_offset, size, limit;
pthread_mutex_lock(&tlv_vector_list_lock);
// Get offset into to TLV vector for the new variable
variable_offset = TLV_vector_offset;
// increment offset for the next new variable
TLV_vector_offset++;
// First check if we need to grow the TLV vectors
size = (int)(default_tlv_vector[1]) >> 2;
limit = size + 2;
if (variable_offset >= limit)
grow_all_tlv_vectors(size+size); // double the size each time we grow
// Put the variable's default value in the default TLV vector
default_tlv_vector[variable_offset] = v;
// Update all the active thread TLV vectors with the default value
update_tlv_vectors(variable_offset, v);
// Finished
pthread_mutex_unlock(&tlv_vector_list_lock);
// return the offset into the TLV vector (an integer, not a pointer)
return((void *)variable_offset);
}
/* 34 */
D primitive_read_thread_variable(D h)
{
TLV_VECTOR tlv_vector;
D value;
int offset;
pthread_mutex_lock(&tlv_vector_list_lock);
// The variable handle is the byte offset where the variable's value is
// stored in the TLV.
offset = (int)h;
tlv_vector = get_tlv_vector();
value = tlv_vector[offset];
pthread_mutex_unlock(&tlv_vector_list_lock);
return value;
}
/* 35 */
D primitive_write_thread_variable(D h, D nv)
{
TLV_VECTOR tlv_vector;
D *destination;
int offset;
pthread_mutex_lock(&tlv_vector_list_lock);
// The variable handle is the byte offset where the variable's value is
// stored in the TLV.
offset = (int)h;
tlv_vector = get_tlv_vector();
destination = tlv_vector[offset] = nv;
pthread_mutex_unlock(&tlv_vector_list_lock);
return(nv);
}
/* 36 */
D primitive_initialize_current_thread(D t, DBOOL synchronize)
{
DTHREAD *thread = (DTHREAD *)t;
TLV_VECTOR tlv_vector;
int size;
assert(thread != NULL);
MSG1("Initializing thread %p\n", t);
// Put the thread object and handle in the TEB for later use
set_current_thread(thread);
set_current_thread_handle((void *)thread->tid);
pthread_mutex_lock(&tlv_vector_list_lock);
// Now set up a vector for the Dylan thread variables
size = (int)(default_tlv_vector[1]) >> 2;
tlv_vector = make_dylan_vector(size);
set_tlv_vector(tlv_vector);
// Initialise the vector with the values from the default vector
copy_tlv_vector(tlv_vector, default_tlv_vector);
// Add thread to active thread list
add_tlv_vector(thread, tlv_vector);
pthread_mutex_unlock(&tlv_vector_list_lock);
// Clear the handle2 slot in the thread object
// (which contained the address of the starting function)
thread->handle2 = DFALSE;
// thread->handle2 = NULL;
return t;
}
/* 36a */
D primitive_initialize_special_thread(D t)
{
MSG1("Initializing special thread %p\n", t);
if (default_tlv_vector == NULL)
initialize_threads_primitives();
return primitive_initialize_current_thread(t, 0);
}
/* 37 */
D primitive_unlock_simple_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
SIMPLELOCK *slock;
assert(lock != NULL);
assert(lock->handle != NULL);
slock = lock->handle;
if (slock->owner == 0) {
/* nothing to do - lock already released */
return OK;
}
slock->owner = 0;
if (pthread_mutex_lock(&slock->mutex)
|| pthread_cond_signal(&slock->cond)
|| pthread_mutex_unlock(&slock->mutex)) {
MSG0("unlock-simple-lock: error releasing mutex\n");
return GENERAL_ERROR;
}
return OK;
}
/* 38 */
D primitive_unlock_recursive_lock(D l)
{
CONTAINER *lock = (CONTAINER *)l;
RECURSIVELOCK *rlock;
assert(lock != NULL);
assert(lock->handle != NULL);
rlock = lock->handle;
if (rlock->owner == 0) {
// nothing to do - lock already released
assert(rlock->count == 0);
return OK;
}
rlock->owner = 0;
rlock->count = 0;
if (pthread_mutex_lock(&rlock->mutex)
|| pthread_cond_signal(&rlock->cond)
|| pthread_mutex_unlock(&rlock->mutex)) {
MSG0("unlock-recursive-lock: error signalling cond\n");
return GENERAL_ERROR;
}
return OK;
}
/* The priority_map function maps dylan thread priorities to windows priorities
* as below:
*
* Dylan Priorities windows priority
* < -1249 THREAD_PRIORITY_IDLE
* -1249 to -750 THREAD_PRIORITY_LOWEST
* -749 to -250 THREAD_PRIORITY_BELOW_NORMAL
* -250 to 249 THREAD_PRIORITY_NORMAL
* 250 to 749 THREAD_PRIORITY_ABOVE_NORMAL
* 750 to 1249 THREAD_PRIORITY_HIGHEST
* > 1249 THREAD_PRIORITY_TIME_CRITICAL
*/
int priority_map(int dylan_priority)
{
return dylan_priority;
/*
int priority;
if (dylan_priority < 0)
if (dylan_priority < -1249)
priority = THREAD_PRIORITY_IDLE;
else
priority = (dylan_priority - 250) / 500;
else
if (dylan_priority > 1249)
priority = THREAD_PRIORITY_TIME_CRITICAL;
else
priority = (dylan_priority + 250) / 500;
return (priority);
*/
}
syntax highlighted by Code2HTML, v. 0.9.1