Lobj *Lmake_exception(Lobj *desc, Lobj *data) {
Lobj *new_exc = 0;
LMalloc(new_exc, LTEXCEPTION_SIZE);
new_exc->Ltype = LTEXCEPTION;
new_exc->Lused = 0;
LINIT(Lexception_description(new_exc), desc);
LINIT(Lexception_data(new_exc), data);
return new_exc;
}
Lobj *Lmake_symbol(Lobj *name, Lobj *doc, Lobj *init_val) {
Lobj *new_symbol = 0;
LMalloc(new_symbol, LTSYMBOL_SIZE);
new_symbol->Ltype = LTSYMBOL;
new_symbol->Lused = 0;
LINIT(Lsymbol_name(new_symbol), name);
LINIT(Lsymbol_doc(new_symbol), doc);
LINIT(Lsymbol_vals(new_symbol), Lmake_cons(init_val, 0));
return new_symbol;
}
Lobj *Lmake_func(const char *name, const char *doc, Lfunction f) {
Lobj *new_func = 0;
LMalloc(new_func, LTFUNC_SIZE);
new_func->Ltype = LTFUNC;
new_func->Lused = -1;
LINIT(Lfunc_name(new_func), Lmake_string(name));
LINIT(Lfunc_doc(new_func), Lmake_string(doc));
Lfunc_func(new_func) = f;
return new_func;
}
Lobj *LUDobject_equals(Lobj *udo1, Lobj *udo2) {
/* BEGIN HACK */
return (udo1 == udo2) ? Lt : Lnil;
/* END HACK */
Lobj *args;
LINIT(args, Lmake_list(2, udo1, udo2));
Lobj *ret;
LINIT(ret, Lapply(LUDclass_instance_equals(LUDobject_class(udo1)), args));
Lrelease(args);
Lrelease_no_delete(ret);
return ret;
}
/*! \internal
\brief Preps a thread for use with kmq
\note Obtains ::cs_kmq_global
*/
void kmqint_attach_this_thread(void) {
kmq_queue * q;
EnterCriticalSection(&cs_kmq_global);
q = (kmq_queue *) TlsGetValue(kmq_tls_queue);
if(!q) {
q = PMALLOC(sizeof(kmq_queue));
InitializeCriticalSection(&q->cs);
q->thread = GetCurrentThreadId();
QINIT(q);
LINIT(q);
q->wait_o = CreateEvent(NULL, FALSE, FALSE, NULL);
q->load = 0;
q->last_post = 0;
q->flags = 0;
LPUSH(&queues, q);
TlsSetValue(kmq_tls_queue, (LPVOID) q);
}
LeaveCriticalSection(&cs_kmq_global);
}
KHMEXP void
perf_set_thread_desc(const char * file, int line,
const wchar_t * name, const wchar_t * creator) {
thread_info * t;
char * fn_copy;
perf_once();
t = malloc(sizeof(*t));
ZeroMemory(t, sizeof(*t));
#ifdef _WIN32
t->thread = GetCurrentThreadId();
#else
#error Unsupported platform
#endif
StringCbCopy(t->name, sizeof(t->name), name);
if (creator)
StringCbCopy(t->creator, sizeof(t->creator), creator);
if (file[0] == '.' && file[1] == '\\')
file += 2;
EnterCriticalSection(&cs_alloc);
fn_copy = hash_lookup(&fn_hash, file);
if (fn_copy == NULL) {
size_t cblen = 0;
if (FAILED(StringCbLengthA(file, MAX_PATH * sizeof(char),
&cblen)))
fn_copy = NULL;
else {
fn_copy = malloc(cblen + sizeof(char));
if (fn_copy) {
hash_bin * b;
int hv;
StringCbCopyA(fn_copy, cblen + sizeof(char), file);
hv = fn_hash.hash(fn_copy) % fn_hash.n;
b = malloc(sizeof(*b));
b->data = fn_copy;
b->key = fn_copy;
LINIT(b);
LPUSH(&fn_hash.bins[hv], b);
}
}
}
t->file = fn_copy;
t->line = line;
LPUSH(&threads, t);
LeaveCriticalSection(&cs_alloc);
}
Lobj *Lmake_UDobject(Lobj *udc) {
Lobj *new_udo = Lnil;
LMalloc(new_udo, LTUDOBJECT_SIZE);
new_udo->Ltype = LTUDOBJECT;
new_udo->Lused = 0;
LINIT(LUDobject_class(new_udo), udc);
LUDobject_members(new_udo) = 0;
LUDclass_init_instance(udc, new_udo);
return new_udo;
}
/*! \internal
\note Obtains ::cs_kmq_types, ::cs_kmq_global
*/
KHMEXP khm_int32 KHMAPI kmq_subscribe(khm_int32 type, kmq_callback_t cb) {
kmq_msg_subscription * s;
s = PMALLOC(sizeof(kmq_msg_subscription));
ZeroMemory(s, sizeof(*s));
s->magic = KMQ_MSG_SUB_MAGIC;
LINIT(s);
s->queue = kmqint_get_thread_queue();
s->rcpt_type = KMQ_RCPTTYPE_CB;
s->recipient.cb = cb;
kmqint_msg_type_add_sub(type, s);
return KHM_ERROR_SUCCESS;
}
/*! \internal
\brief Subscribes a window to a message type
\note Obtains ::cs_kmq_types
*/
KHMEXP khm_int32 KHMAPI kmq_subscribe_hwnd(khm_int32 type, HWND hwnd) {
kmq_msg_subscription * s;
s = PMALLOC(sizeof(kmq_msg_subscription));
ZeroMemory(s, sizeof(*s));
s->magic = KMQ_MSG_SUB_MAGIC;
LINIT(s);
s->queue = NULL;
s->rcpt_type = KMQ_RCPTTYPE_HWND;
s->recipient.hwnd = hwnd;
kmqint_msg_type_add_sub(type, s);
return KHM_ERROR_SUCCESS;
}
Lobj *LUDobject_call_method(Lobj *udo, int m, Lobj *args) {
if((m >= LUDclass_num_methods(LUDobject_class(udo))) || (m < 0))
return Lmake_exception(Lmake_string("Method index out of range: "), Lmake_number(m));
Lcapture(udo);
Lcapture(args);
LUDobject_enter_scope(udo);
Lobj *ret;
LINIT(ret, Lapply(LUDclass_methods(LUDobject_class(udo))[m], args));
LUDobject_exit_scope(udo);
Lrelease(args);
Lrelease(udo);
Lrelease_no_delete(ret);
return ret;
}
/*! \internal
\brief Create a message type
\note Obtains ::cs_kmq_types
*/
void kmqint_msg_type_create(int t) {
if(t < 0 || t > KMQ_MSG_TYPE_MAX)
return;
EnterCriticalSection(&cs_kmq_types);
if(!msg_types[t]) {
kmq_msg_type * mt;
mt = PMALLOC(sizeof(kmq_msg_type));
ZeroMemory(mt, sizeof(kmq_msg_type));
mt->id = t;
LINIT(mt);
mt->subs = NULL;
msg_types[t] = mt;
LPUSH(&all_msg_types, mt);
}
LeaveCriticalSection(&cs_kmq_types);
}
static kherr_event *
fold_context(kherr_context * c)
{
kherr_event * e;
kherr_event * g;
if (!IS_KHERR_CTX(c))
return NULL;
EnterCriticalSection(&cs_error);
if(!c->err_event || (c->flags & KHERR_CF_DIRTY)) {
pick_err_event(c);
}
if(c->err_event) {
g = c->err_event;
e = get_empty_event();
*e = *g;
g->short_desc = NULL;
g->long_desc = NULL;
g->suggestion = NULL;
g->flags &=
~(KHERR_RF_FREE_SHORT_DESC |
KHERR_RF_FREE_LONG_DESC |
KHERR_RF_FREE_SUGGEST);
LINIT(e);
e->p1 = dup_parm(g->p1);
e->p2 = dup_parm(g->p2);
e->p3 = dup_parm(g->p3);
e->p4 = dup_parm(g->p4);
} else {
e = c->desc_event;
c->desc_event = NULL;
}
if (IS_KHERR_EVENT(e)) {
e->flags |= KHERR_RF_CONTEXT_FOLD;
e->flags &= ~KHERR_RF_COMMIT;
}
LeaveCriticalSection(&cs_error);
return e;
}
/*! \internal
\note Obtains ::cs_kmq_global
*/
KHMEXP khm_int32 KHMAPI kmq_create_subscription(kmq_callback_t cb,
khm_handle * result)
{
kmq_msg_subscription * s;
s = PMALLOC(sizeof(kmq_msg_subscription));
ZeroMemory(s, sizeof(*s));
s->magic = KMQ_MSG_SUB_MAGIC;
LINIT(s);
s->queue = kmqint_get_thread_queue();
s->rcpt_type = KMQ_RCPTTYPE_CB;
s->recipient.cb = cb;
EnterCriticalSection(&cs_kmq_global);
LPUSH(&kmq_adhoc_subs, s);
LeaveCriticalSection(&cs_kmq_global);
*result = (khm_handle) s;
return KHM_ERROR_SUCCESS;
}
KHMEXP khm_int32 KHMAPI kmq_create_hwnd_subscription(HWND hw,
khm_handle * result)
{
kmq_msg_subscription * s;
s = PMALLOC(sizeof(kmq_msg_subscription));
ZeroMemory(s, sizeof(*s));
s->magic = KMQ_MSG_SUB_MAGIC;
LINIT(s);
s->queue = NULL;
s->rcpt_type = KMQ_RCPTTYPE_HWND;
s->recipient.hwnd = hw;
EnterCriticalSection(&cs_kmq_global);
LPUSH(&kmq_adhoc_subs, s);
LeaveCriticalSection(&cs_kmq_global);
*result = (khm_handle) s;
return KHM_ERROR_SUCCESS;
}
KHMEXP khm_int32 KHMAPI
kcdb_credset_create(khm_handle * result)
{
kcdb_credset * cs;
cs = PMALLOC(sizeof(kcdb_credset));
ZeroMemory(cs, sizeof(kcdb_credset));
cs->magic = KCDB_CREDSET_MAGIC;
InitializeCriticalSection(&(cs->cs));
LINIT(cs);
kcdb_credset_buf_new(cs);
cs->version = 0;
cs->seal_count = 0;
EnterCriticalSection(&cs_credset);
LPUSH(&kcdb_credsets, cs);
LeaveCriticalSection(&cs_credset);
*result = (khm_handle) cs;
return KHM_ERROR_SUCCESS;
}
KHMEXP void *
perf_malloc(const char * file, int line, size_t s) {
allocation * a;
void * ptr;
size_t h;
char * fn_copy = NULL;
perf_once();
assert(s > 0);
EnterCriticalSection(&cs_alloc);
a = get_allocation();
ptr = malloc(s);
assert(ptr); /* TODO: handle this gracefully */
if (file[0] == '.' && file[1] == '\\')
file += 2;
fn_copy = hash_lookup(&fn_hash, file);
if (fn_copy == NULL) {
size_t cblen = 0;
if (FAILED(StringCbLengthA(file, MAX_PATH * sizeof(char),
&cblen)))
fn_copy = NULL;
else {
fn_copy = malloc(cblen + sizeof(char));
if (fn_copy) {
hash_bin * b;
int hv;
StringCbCopyA(fn_copy, cblen + sizeof(char), file);
hv = fn_hash.hash(fn_copy) % fn_hash.n;
b = malloc(sizeof(*b));
b->data = fn_copy;
b->key = fn_copy;
LINIT(b);
LPUSH(&fn_hash.bins[hv], b);
}
}
}
a->file = fn_copy;
a->line = line;
a->size = s;
a->ptr = ptr;
#ifdef _WIN32
a->thread = GetCurrentThreadId();
#endif
h = HASHPTR(ptr);
LPUSH(&ht[h], a);
LeaveCriticalSection(&cs_alloc);
return ptr;
}
KHMEXP khm_int32 KHMAPI kcdb_type_register(const kcdb_type * type, khm_int32 * new_id)
{
kcdb_type_i *t;
size_t cbsize;
khm_int32 type_id;
if(!type ||
!type->comp ||
!type->dup ||
!type->isValid ||
!type->toString ||
!type->name)
return KHM_ERROR_INVALID_PARAM;
if((type->flags & KCDB_TYPE_FLAG_CB_MIN) &&
(type->cb_min < 0 || type->cb_min > KCDB_TYPE_MAXCB))
{
return KHM_ERROR_INVALID_PARAM;
}
if((type->flags & KCDB_TYPE_FLAG_CB_MAX) &&
(type->cb_max < 0 || type->cb_max > KCDB_TYPE_MAXCB))
{
return KHM_ERROR_INVALID_PARAM;
}
if((type->flags & KCDB_TYPE_FLAG_CB_MIN) &&
(type->flags & KCDB_TYPE_FLAG_CB_MAX) &&
(type->cb_max < type->cb_min))
{
return KHM_ERROR_INVALID_PARAM;
}
if(FAILED(StringCbLength(type->name, KCDB_MAXCB_NAME, &cbsize)))
return KHM_ERROR_TOO_LONG;
cbsize += sizeof(wchar_t);
EnterCriticalSection(&cs_type);
if(type->id == KCDB_TYPE_INVALID) {
kcdb_type_get_next_free(&type_id);
} else if(type->id < 0 || type->id > KCDB_TYPE_MAX_ID) {
LeaveCriticalSection(&cs_type);
return KHM_ERROR_INVALID_PARAM;
} else if(kcdb_type_tbl[type->id]) {
LeaveCriticalSection(&cs_type);
return KHM_ERROR_DUPLICATE;
} else {
type_id = type->id;
}
if(type_id == KCDB_TYPE_INVALID) {
LeaveCriticalSection(&cs_type);
return KHM_ERROR_NO_RESOURCES;
}
t = PMALLOC(sizeof(kcdb_type_i));
ZeroMemory(t, sizeof(kcdb_type_i));
t->type.name = PMALLOC(cbsize);
StringCbCopy(t->type.name, cbsize, type->name);
t->type.comp = type->comp;
t->type.dup = type->dup;
t->type.flags = type->flags;
t->type.id = type_id;
t->type.isValid = type->isValid;
t->type.toString = type->toString;
LINIT(t);
kcdb_type_tbl[type_id] = t;
LPUSH(&kcdb_types, t);
hash_add(kcdb_type_namemap, (void *) t->type.name, (void *) t);
LeaveCriticalSection(&cs_type);
if(new_id)
*new_id = type_id;
kcdb_type_post_message(KCDB_OP_INSERT, t);
return KHM_ERROR_SUCCESS;
}
