ssize_t lisp_write(HANDLE hfile, void *buf, ssize_t count) { HANDLE hevent; OVERLAPPED overlapped; DWORD err, nwritten, wait_result; pending_io pending; TCR *tcr = (TCR *)get_tcr(1); hevent = (HANDLE)TCR_AUX(tcr)->io_datum; if (hfile == (HANDLE)1) { hfile = GetStdHandle(STD_OUTPUT_HANDLE); } else if (hfile == (HANDLE) 2) { hfile = GetStdHandle(STD_ERROR_HANDLE); } memset(&overlapped,0,sizeof(overlapped)); if (GetFileType(hfile) == FILE_TYPE_DISK) { overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT); } pending.h = hfile; pending.o = &overlapped; TCR_AUX(tcr)->pending_io_info = &pending; overlapped.hEvent = hevent; ResetEvent(hevent); if (WriteFile(hfile, buf, count, &nwritten, &overlapped)) { TCR_AUX(tcr)->pending_io_info = NULL; return nwritten; } err = GetLastError(); if (err != ERROR_IO_PENDING) { _dosmaperr(err); TCR_AUX(tcr)->pending_io_info = NULL; return -1; } err = 0; wait_result = WaitForSingleObjectEx(hevent, INFINITE, true); TCR_AUX(tcr)->pending_io_info = NULL; if (wait_result == WAIT_OBJECT_0) { err = overlapped.Internal; if (err) { _dosmaperr(err); return -1; } return overlapped.InternalHigh; } if (wait_result == WAIT_IO_COMPLETION) { CancelIo(hfile); errno = EINTR; return -1; } err = GetLastError(); _dosmaperr(err); return -1; }
void show_lisp_register(ExceptionInformation *xp, char *label, int r) { extern char* print_lisp_object(LispObj); LispObj val = xpGPR(xp, r); #ifdef PPC fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val)); #endif #ifdef X8664 fprintf(dbgout, "%%%s (%s) = %s\n",Iregnames[r], label, print_lisp_object(val)); #endif #ifdef X8632 { TCR *tcr = get_tcr(false); char *s; if (r == REG_EDX && (xpGPR(xp, REG_EFL) & EFL_DF)) s = "marked as unboxed (DF set)"; else if (tcr && (tcr->node_regs_mask & bit_for_regnum(r)) == 0) s = "marked as unboxed (node_regs_mask)"; else s = print_lisp_object(val); fprintf(dbgout, "%%%s (%s) = %s\n", Iregnames[r], label, s); } #endif #ifdef ARM fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val)); #endif }
void walk_other_areas() { TCR *start = (TCR *)get_tcr(true), *tcr = start->next; area *a; char *ilevel = interrupt_level_description(tcr); while (tcr != start) { a = tcr->cs_area; Dprintf("\n\n TCR = 0x%lx, cstack area #x%lx, native thread ID = 0x%lx, interrupts %s", tcr, a, tcr->native_thread_id, ilevel); walk_stack_frames((lisp_frame *) (a->active), (lisp_frame *) (a->high)); tcr = tcr->next; } }
void plbt_sp(LispObj currentSP) { area *cs_area; { TCR *tcr = (TCR *)get_tcr(true); char *ilevel = interrupt_level_description(tcr); cs_area = tcr->cs_area; if ((((LispObj) ptr_to_lispobj(cs_area->low)) > currentSP) || (((LispObj) ptr_to_lispobj(cs_area->high)) < currentSP)) { Dprintf("\nStack pointer [#x%lX] in unknown area.", currentSP); } else { fprintf(dbgout, "current thread: tcr = 0x%lx, native thread ID = 0x%lx, interrupts %s\n", tcr, tcr->native_thread_id, ilevel); walk_stack_frames((lisp_frame *) ptr_from_lispobj(currentSP), (lisp_frame *) (cs_area->high)); walk_other_areas(); } } }
ssize_t lisp_standard_read(HANDLE hfile, void *buf, unsigned int count) { HANDLE hevent; OVERLAPPED overlapped; DWORD err, nread, wait_result; pending_io pending; TCR *tcr; memset(&overlapped,0,sizeof(overlapped)); if (GetFileType(hfile) == FILE_TYPE_DISK) { overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT); } tcr = (TCR *)get_tcr(1); pending.h = hfile; pending.o = &overlapped; TCR_AUX(tcr)->pending_io_info = &pending; hevent = (HANDLE)(TCR_AUX(tcr)->io_datum); overlapped.hEvent = hevent; ResetEvent(hevent); if (ReadFile(hfile, buf, count, &nread, &overlapped)) { TCR_AUX(tcr)->pending_io_info = NULL; return nread; } err = GetLastError(); if (err == ERROR_HANDLE_EOF) { TCR_AUX(tcr)->pending_io_info = NULL; return 0; } if (err != ERROR_IO_PENDING) { _dosmaperr(err); TCR_AUX(tcr)->pending_io_info = NULL; return -1; } err = 0; /* We block here */ wait_result = WaitForSingleObjectEx(hevent, INFINITE, true); TCR_AUX(tcr)->pending_io_info = NULL; if (wait_result == WAIT_OBJECT_0) { err = overlapped.Internal; if (err == ERROR_HANDLE_EOF) { return 0; } if (err) { _dosmaperr(err); return -1; } return overlapped.InternalHigh; } if (wait_result == WAIT_IO_COMPLETION) { CancelIo(hfile); errno = EINTR; return -1; } err = GetLastError(); switch (err) { case ERROR_HANDLE_EOF: return 0; default: _dosmaperr(err); return -1; } }