int lutex_wait (tagged_lutex_t tagged_queue_lutex, tagged_lutex_t tagged_mutex_lutex) { int ret; struct lutex *queue_lutex = (struct lutex*) native_pointer(tagged_queue_lutex); struct lutex *mutex_lutex = (struct lutex*) native_pointer(tagged_mutex_lutex); ret = pthread_cond_wait(queue_lutex->condition_variable, mutex_lutex->mutex); lutex_assert(ret == 0); return ret; }
int lutex_destroy (tagged_lutex_t tagged_lutex) { struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); if (lutex->condition_variable) { pthread_cond_destroy(lutex->condition_variable); free(lutex->condition_variable); lutex->condition_variable = NULL; } if (lutex->mutex) { pthread_mutex_destroy(lutex->mutex); free(lutex->mutex); lutex->mutex = NULL; } if (lutex->mutexattr) { pthread_mutexattr_destroy(lutex->mutexattr); free(lutex->mutexattr); lutex->mutexattr = NULL; } return 0; }
static void search_cmd(char **ptr) { static int lastval = 0, lastcount = 0; static lispobj *start = 0, *end = 0; int val, count; lispobj *addr, obj; if (more_p(ptr)) { val = parse_number(ptr); if (val < 0 || val > 0xff) { printf("can only search for single bytes\n"); return; } if (more_p(ptr)) { addr = (lispobj *)native_pointer((uword_t)parse_addr(ptr)); if (more_p(ptr)) { count = parse_number(ptr); } else { /* Specified value and address, but no count. Only one. */ count = -1; } } else { /* Specified a value, but no address, so search same range. */ addr = start; count = lastcount; } } else { /* Specified nothing, search again for val. */ val = lastval; addr = end; count = lastcount; } lastval = val; start = end = addr; lastcount = count; printf("searching for 0x%x at %p\n", val, (void*)(uword_t)end); while (search_for_type(val, &end, &count)) { printf("found 0x%x at %p:\n", val, (void*)(uword_t)end); obj = *end; addr = end; end += 2; if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) { print((uword_t)addr | FUN_POINTER_LOWTAG); } else if (other_immediate_lowtag_p(obj)) { print((lispobj)addr | OTHER_POINTER_LOWTAG); } else { print((lispobj)addr); } if (count == -1) { return; } } }
static long compute_offset(os_context_t *context, lispobj code) { if (code == NIL) return 0; else { uword_t code_start; struct code *codeptr = (struct code *)native_pointer(code); #ifdef LISP_FEATURE_HPPA uword_t pc = *os_context_pc_addr(context) & ~3; #else uword_t pc = *os_context_pc_addr(context); #endif code_start = (uword_t)codeptr + HeaderValue(codeptr->header)*sizeof(lispobj); if (pc < code_start) return 0; else { uword_t offset = pc - code_start; if (offset >= (uword_t)fixnum_value(codeptr->code_size)) return 0; else return make_fixnum(offset); } } }
static struct code * code_pointer(lispobj object) { lispobj *headerp, header; int type, len; headerp = (lispobj *) native_pointer(object); header = *headerp; type = widetag_of(header); switch (type) { case CODE_HEADER_WIDETAG: break; case RETURN_PC_HEADER_WIDETAG: case SIMPLE_FUN_HEADER_WIDETAG: len = HEADER_LENGTH(header); if (len == 0) headerp = NULL; else headerp -= len; break; default: headerp = NULL; } return (struct code *) headerp; }
int lutex_wake (tagged_lutex_t tagged_lutex, int n) { int ret = 0; struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); /* The lisp-side code passes N=2**29-1 for a broadcast. */ if (n >= ((1 << 29) - 1)) { /* CONDITION-BROADCAST */ ret = pthread_cond_broadcast(lutex->condition_variable); lutex_assert(ret == 0); } else{ /* We're holding the condition variable mutex, so a thread * we're waking can't re-enter the wait between to calls to * pthread_cond_signal. Thus we'll wake N different threads, * instead of the same thread N times. */ while (n--) { ret = pthread_cond_signal(lutex->condition_variable); lutex_assert(ret == 0); } } return ret; }
static void call_info_from_context(struct call_info *info, os_context_t *context) { unsigned long pc; info->interrupted = 1; if (lowtag_of(*os_context_register_addr(context, reg_CODE)) == FUN_POINTER_LOWTAG) { /* We tried to call a function, but crapped out before $CODE could * be fixed up. Probably an undefined function. */ info->frame = (struct call_frame *)(unsigned long) (*os_context_register_addr(context, reg_OCFP)); info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA)); info->code = code_pointer(info->lra); pc = (unsigned long)native_pointer(info->lra); } else { info->frame = (struct call_frame *)(unsigned long) (*os_context_register_addr(context, reg_CFP)); info->code = code_pointer(*os_context_register_addr(context, reg_CODE)); info->lra = NIL; pc = *os_context_pc_addr(context); } if (info->code != NULL) info->pc = pc - (unsigned long) info->code - #ifndef LISP_FEATURE_ALPHA (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); #else (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj)); #endif else
static void *compute_pc(lispobj code_obj, int pc_offset) { struct code *code; code = (struct code *)native_pointer(code_obj); return (void *)((char *)code + HeaderValue(code->header)*sizeof(lispobj) + pc_offset); }
static lispobj trans_sap(lispobj object) { gc_assert(is_lisp_pointer(object)); enqueue_sap_pointer(((struct sap *)native_pointer(object))->pointer); return copy_unboxed_object(object, 2); }
static void print_entry_name (lispobj name) { if (lowtag_of (name) == LIST_POINTER_LOWTAG) { putchar('('); while (name != NIL) { struct cons *cons = (struct cons *) native_pointer(name); print_entry_name(cons->car); name = cons->cdr; if (name != NIL) putchar(' '); } putchar(')'); } else if (lowtag_of(name) == OTHER_POINTER_LOWTAG) { lispobj *object = (lispobj *) native_pointer(name); if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) { struct symbol *symbol = (struct symbol *) object; if (symbol->package != NIL) { struct package *pkg = (struct package *) native_pointer(symbol->package); lispobj pkg_name = pkg->_name; if (string_equal(native_pointer(pkg_name), "COMMON-LISP")) ; else if (string_equal(native_pointer(pkg_name), "COMMON-LISP-USER")) { fputs("CL-USER::", stdout); } else if (string_equal(native_pointer(pkg_name), "KEYWORD")) { putchar(':'); } else { print_string(native_pointer(pkg_name)); fputs("::", stdout); } } print_string(native_pointer(symbol->name)); } else if (widetag_of(*object) == SIMPLE_BASE_STRING_WIDETAG #ifdef SIMPLE_CHARACTER_STRING_WIDETAG || widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG #endif ) { putchar('"'); print_string(object); putchar('"'); } else { printf("<??? type %d>", (int) widetag_of(*object)); } } else { printf("<??? lowtag %d>", (int) lowtag_of(name)); } }
static void print_entry_points (struct code *code) { lispobj function = code->entry_points; while (function != NIL) { struct simple_fun *header = (struct simple_fun *) native_pointer(function); print_entry_name(header->name); function = header->next; if (function != NIL) printf (", "); } }
int lutex_trylock (tagged_lutex_t tagged_lutex) { int ret = 0; struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); ret = pthread_mutex_trylock(lutex->mutex); /* The mutex is locked */ if (ret == EDEADLK || ret == EBUSY) return ret; lutex_assert(ret == 0); return ret; }
int lutex_unlock (tagged_lutex_t tagged_lutex) { int ret = 0; struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); ret = thread_mutex_unlock(lutex->mutex); /* Unlocking unlocked mutex would occur as: * (with-mutex (mutex) (cond-wait cond mutex)) */ if (ret == EPERM) return ret; lutex_assert(ret == 0); return ret; }
void *handle_fun_end_breakpoint(os_context_t *context) { lispobj code, lra; struct code *codeptr; DX_ALLOC_SAP(context_sap, context); fake_foreign_function_call(context); #ifndef LISP_FEATURE_SB_SAFEPOINT unblock_gc_signals(0, 0); #endif code = find_code(context); codeptr = (struct code *)native_pointer(code); #ifndef LISP_FEATURE_WIN32 /* Don't disallow recursive breakpoint traps. Otherwise, we can't * use debugger breakpoints anywhere in here. */ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0); #endif funcall3(StaticSymbolFunction(HANDLE_BREAKPOINT), compute_offset(context, code), code, context_sap); lra = codeptr->constants[REAL_LRA_SLOT]; #ifdef LISP_FEATURE_PPC /* PPC now passes LRA objects in reg_LRA during return. Other * platforms should as well, but haven't been fixed yet. */ *os_context_register_addr(context, reg_LRA) = lra; #else #ifdef reg_CODE *os_context_register_addr(context, reg_CODE) = lra; #endif #endif undo_fake_foreign_function_call(context); #ifdef reg_LRA return (void *)(lra-OTHER_POINTER_LOWTAG+sizeof(lispobj)); #else return compute_pc(lra, fixnum_value(codeptr->constants[REAL_LRA_SLOT+1])); #endif }
int lutex_lock (tagged_lutex_t tagged_lutex) { int ret = 0; struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); ret = thread_mutex_lock(lutex->mutex); /* The mutex is locked by the same thread. * * FIXME: Usually when POSIX says that "an error value is returned" * it actually refers to errno... */ if (ret == EDEADLK) return ret; lutex_assert(ret == 0); return ret; }
int lutex_init (tagged_lutex_t tagged_lutex) { int ret; struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); lutex->mutexattr = malloc(sizeof(pthread_mutexattr_t)); lutex_assert(lutex->mutexattr != 0); ret = pthread_mutexattr_init(lutex->mutexattr); lutex_assert(ret == 0); /* The default type of mutex is implementation dependent. * We use PTHREAD_MUTEX_ERRORCHECK so that locking on mutexes * locked by the same thread does not cause deadlocks. */ /* FIXME: pthread_mutexattr_settype is available on SUSv2 level * implementations. Can be used without checking? */ ret = pthread_mutexattr_settype(lutex->mutexattr, PTHREAD_MUTEX_ERRORCHECK); lutex_assert(ret == 0); lutex->mutex = malloc(sizeof(pthread_mutex_t)); lutex_assert(lutex->mutex != 0); ret = pthread_mutex_init(lutex->mutex, lutex->mutexattr); lutex_assert(ret == 0); lutex->condition_variable = malloc(sizeof(pthread_cond_t)); lutex_assert(lutex->condition_variable != 0); ret = pthread_cond_init(lutex->condition_variable, NULL); lutex_assert(ret == 0); ret = thread_mutex_lock(&lutex_register_lock); lutex_assert(ret == 0); gencgc_register_lutex(lutex); ret = thread_mutex_unlock(&lutex_register_lock); lutex_assert(ret == 0); return ret; }
struct compiled_debug_fun * debug_function_from_pc (struct code* code, void *pc) { uword_t code_header_len = sizeof(lispobj) * HeaderValue(code->header); uword_t offset = (uword_t) pc - (uword_t) code - code_header_len; struct compiled_debug_fun *df; struct compiled_debug_info *di; struct vector *v; int i, len; if (lowtag_of(code->debug_info) != INSTANCE_POINTER_LOWTAG) return 0; di = (struct compiled_debug_info *) native_pointer(code->debug_info); v = (struct vector *) native_pointer(di->fun_map); len = fixnum_value(v->length); df = (struct compiled_debug_fun *) native_pointer(v->data[0]); if (len == 1) return df; for (i = 1;; i += 2) { unsigned next_pc; if (i == len) return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1])); if (offset >= (uword_t)fixnum_value(df->elsewhere_pc)) { struct compiled_debug_fun *p = ((struct compiled_debug_fun *) native_pointer(v->data[i + 1])); next_pc = fixnum_value(p->elsewhere_pc); } else next_pc = fixnum_value(v->data[i]); if (offset < next_pc) return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1])); } return NULL; }