Example #1
0
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
}
Example #3
0
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;
  }
}
Example #4
0
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();
    }
  } 
}
Example #5
0
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;
  }
}