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;
}
}
