//
// File: debug.cpp
// Implementation of debugger services and API
// F.J. Alberti
// Last Modified: 21/05/2001
//
// Note #1:
// The functions that use Interpreter::current to retrieve the current executing
// instance suppose that the vm context attached to the instance is the same
// as the vm contect passed as parameter to the called service. This is the case
// in the current implementation of the runtime, but it might change in the future.
//
// Modification history:
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER
//$ FA(17/01/2002): Call to SCdestroychannel() with extra 'notify' argument set to 0
//

#include "align.h"
#include "base.h"                // future types.h
#include "baselib.h"
#include "debug.h"
#include "interp.h"
#include "lexer.h"
#include "macros.h"
#include "mbytec.h"
extern "C" {
# include "fifo.h"
# include "listlab.h"
# include "loadpak.h"
# include "scol.h"
# include "scolpack.h"
# include "scolsys.h"
#if defined(INCLUDE_DEBUGGER) // && defined(SCOL_WIN)
# include "include/socket.h"
  extern HWND hscol;
#endif
}
#include <string.h>


// Debugger client instance
DBGClient debug;
// Unique object counters
uint chnID = 0;
uint pkgID = 0;
uint varID = 0;


// Debugger client error messages
#define MSGEDEBUGREINIT       "Debugger client interface reinitialised!"
#define MSGEDEBUGSOCKET       "Socket error #%d. (See Windows Sockets errors reference)"
#define MSGEDEBUGNOSERVER     "Debugging server is unavailable or down"
#define MSGEDEBUGSERVERDOWN   "Debugging server connection abruptly closed!"
#define MSGEDEBUGCLOSING      "Silently closing client..."
#define MSGEDEBUGILLSERVICE   "Unknown debugger service '%s'"
#define MSGEDEBUGREQUEST      "Debugger request error"
#define MSGEDEBUGMODESWITCH   "Cannot activate/deactivate asynchronic notification. (Windows only)"


int DBGInit(mmachine m)
{
#if defined(INCLUDE_DEBUGGER)
  static int init = 0;

  // Only one instance is available
  if (init) {
    MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGREINIT"!\n");
    return MERRDEBUG;
  }
  // Initialise debugger client structure
  debug.currState     = kVMIdle;
  debug.lastState     = kVMUnknown;
  debug.sock          = 0;
  debug.addr[0]       = '\0';
  debug.traceMode     = kTraceNone;
  debug.traceFP       = 0;
  debug.script[0]     = '\0';
  debug.scriptBegLine = 0;
  debug.scriptBegOff  = 0;
  debug.scriptEndLine = 0;
  debug.scriptEndOff  = 0;
  debug.brksrc        = kBrksrcUndefined;

  // Create SCOL-side debugger client structure
  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, SEI2W(DBG_SIZE)));
  SECHECK(SENEWTUPLE(m));
  SESETROOT(m, OFFSCDEBUG, SEPOP(m));
  init = 1;
#endif
  return MERROK;
}


#if defined(INCLUDE_DEBUGGER)

// Forward declarations
static int DBGPushValue(mmachine m);


void DBGSetState(VMState state)
{
  debug.currState = state;
}


static int DBGSendMessage(mmachine m, unsigned int nargs, char* fmt)
{
  // Create a tuple with the arguments of the message in the stack
  SECHECK(SEPUSH(m, SEI2W(nargs)));
  SECHECK(SENEWTUPLE(m));

  // Push the message as a SCOL comm, ready to be sent
  int res;
  if (res = Mpushstring(m, fmt))
    return res;
  if (res = MBcom(m))
	return res;

  // Print out message and length
  char* msg = SECSTR(m, SEW2P(SEPOP(m)));
  int   len = strlen(&msg[2])+1;
  MMechostr(MSKTRACE, "Sending %d bytes over debugging channel: '%s'\n", len, &msg[2]);
  
  // Send it!
  if ((res = SCKsend(debug.sock, msg, len+2)) < 0)
    return res;
  if (res == 0) {
    MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGNOSERVER"\n", res);
	  debug.sock = 0;
    return MERRDEBUG;
  }

  return MERROK;
}


static int DBGRegisterClient(mmachine m)
{
  int res;

  // Push machine name
  if (SEGETROOT(m, OFFSCNAME) == NIL) {
    if (res = Mpushstrbloc(m, DEBUG_STANDARD_CLIENT_NAME))
      return res;
  } else
    SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCNAME)));

  // Push version of debugging protocol
  if (res = Mpushstrbloc(m, DEBUG_PROTOCOL_VERSION))
	  return res;
  return DBGSendMessage(m, 2, "register S S");
}


static int DBGOpenChannel(mmachine m)
{
  // If a debugging channel is opened, close it first
  if (SEGETROOT(m, OFFSCDEBUG) != NIL)
    SCdestroychannel(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_OFFCHN), 0);
  // Save current channel on the stack
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCUR)));
  // Open debug channel on specified address
  int res;
  if (res = Mpushstrbloc(m, debug.addr))
    return res;
  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, NIL));
  debug.sock = -1; // to indicate that a socket has been requested
  if (res = SCopenchannel(m))
    return res;
  // Returned channel is on top of the stack
  debug.sock = SCgetsocket(m, SEGETTOP(m, 0));
  // Save channel in debugging record
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_OFFCHN, SEPOP(m));
  // Restore current channel
  SESETROOT(m, OFFSCCUR, SEPOP(m));
  // Tell debugger that a new client requests its services
  if (res = DBGRegisterClient(m))
    return res;
  return MERROK;
}


void DBGCloseChannel(mmachine m)
// Closes debugger's channel
{
  if (debug.sock) {
    MMechostr(MSKTRACE, "Closing debugging channel...");
    SCKclose(debug.sock); // close socket
    debug.sock = 0;
  } 
}


int DBGEcho(mmachine m)
// [0] string to echo to debugger's console by _fooXXX functions
{
  if (debug.sock)
    return DBGSendMessage(m, 1, "echo S");
  SEDROP(m, 1);
  return MERROK;
}



//
// Notifiers
//

static int DBGNotifyState(mmachine m)
{
  if (!debug.sock)
    return MERROK;

  char* s;
  switch (debug.currState) {
    case kVMIdle:
      s = "idle";
	    break;
	  case kVMRunning:
	    s = "running";
	    break;
	  case kVMIssuedBreak:
	    s = (debug.lastState == kVMIdle) ? "idle" : "running";
	    break;
	  case kVMSuspended:
	  case kVMIssuedResume:
	    s = "suspended";
	    break;
	  case kVMKilled:       // only observable through notification
	    s = "killed";
	    break;
	  default:  
	    s = "";
  } // switch

  int res;
  if (res = Mpushstrbloc(m, s))
    return res;
  return DBGSendMessage(m, 1, "state S");
}


int DBGNotifyCallStackPushed(mmachine m)
// [0] stack division depth
{
  if (debug.sock && debug.traceMode != kTraceNone)
    return DBGSendMessage(m, 1, "callStackPushed I");
  SEDROP(m, 1);
  return MERROK;
}


int DBGNotifyCallStackPopped(mmachine m)
// [0] stack division depth
{
  if (debug.sock && debug.traceMode != kTraceNone)
    return DBGSendMessage(m, 1, "callStackPopped I");
  SEDROP(m, 1);
  return MERROK;
}


static int DBGPushChannelInfo(mmachine m, int i)
// Push into the stack all needed channel information
// The target channel can be found at index i
{
  int res;
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFCHANID)));   // channel id
  if (res = SCgetsockname(m, SEGET(m, i)))                         // SCOL name
    return res;
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFCHANUSER))); // user name
  return MERROK;
}


int DBGNotifyChannelOpened(mmachine m)
// Notify debugger that a new channel has been opened
// [0] channel
{
  if (debug.sock) {
    int res;
    if (res = DBGPushChannelInfo(m, SEGETSP(m)))
      return res;
    if (res = DBGSendMessage(m, 3, "channelOpened I S S"))
      return res;
  }
  SEDROP(m, 1);
  return MERROK;
}


int DBGNotifyChannelClosed(mmachine m)
// Notify debugger that the given channel is about to be destroyed
// [0] channel
{
  if (debug.sock) {
    int res;
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFCHANID))); // channel id
    if (res = DBGSendMessage(m, 1, "channelClosed I"))
      return res;
  }
  SEDROP(m, 1);
  return MERROK;
}


static int DBGNotifyChannelNameModified(mmachine m)
// Notify debugger that user modified the given channel name with _setchannelname
// [1] channel
// [0] new name
{
  if (debug.sock) {
    int res;
    SEINT i = SEGETSP(m);
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFCHANID))); // channel id
    SECHECK(SEPUSH(m, SEGET(m, i)));                                 // new name
    if (res = DBGSendMessage(m, 2, "channelNameModified I S"))
      return res;
  }
  SEDROP(m, 2);
  return MERROK;
}


static int DBGPushPackageInfo(mmachine m, SEINT i)
// Push into the stack all needed package information
// The target package can be found at index i
{
  int res;
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFPKID)));   // id
  if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFPKNAME)))))
    return res;                                                  // name
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFPKSIZE))); // size
  return MERROK;
}


int DBGNotifyPackageLoaded(mmachine m)
// [0] package
{
  if (debug.sock) {
	  int res;
    // Push current channel (ie, where package was loaded)
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCUR)), OFFCHANID)));
    if (res = DBGPushPackageInfo(m, SEGETSP(m)+1))
      return res;
    if (res = DBGSendMessage(m, 4, "packageLoaded I I S I"))
      return res;
  }
  SEDROP(m, 1);
  return MERROK;
}


int DBGNotifyPackageRemoved(mmachine m)
// [0] package
{
  if (debug.sock) {
    int res;
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFPKID))); // package id
    if (res = DBGSendMessage(m, 1, "packageRemoved I"))
      return res;
  }
  SEDROP(m, 1);
  return MERROK;
}


int DBGNotifyAssertionViolated(mmachine m, char* assertion)
{
  if (debug.sock) {
    int res;
    if (res = Mpushstrbloc(m, assertion))
      return res;
    if (res = DBGSendMessage(m, 1, "assertionViolated S"))
      return res;
  }
  return MERROK;
}


int DBGNotifyScriptOpened(mmachine m, const char* script)
{
  strcpy(debug.script, script);
  if (debug.sock && debug.traceMode != kTraceNone) {
    // Push channel id of channel where script will be executed
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCUR)), OFFCHANID)));
    // Push script text
    int res;
  	if (res = Mpushstrbloc(m, debug.script))
	    return res;
    if (res = DBGSendMessage(m, 2, "scriptOpened I S"))
	    return res;
  }
  return MERROK;
}


int DBGNotifyLocalVariablePushed(mmachine m)
// [2] index
// [1] name
// [0] value
{
  if (debug.sock && debug.traceMode != kTraceNone) {
    SEINT i = SEGETSP(m);
    SECHECK(SEPUSH(m, SEGET(m, i+2)));
    SECHECK(SEPUSH(m, SEGET(m, i+1)));
    SECHECK(SEPUSH(m, SEGET(m, i+0)));
    SECHECK(DBGPushValue(m));
    SECHECK(DBGSendMessage(m, 4, "localVariablePushed I S S I"));
  }
  SEDROP(m, 3);
  return MERROK;
}


int DBGNotifyLocalVariablePopped(mmachine m)
// [0] # of locals removed
{
  if (debug.sock && debug.traceMode != kTraceNone) {
    SECHECK(SEDUP(m));
    SECHECK(DBGSendMessage(m, 1, "localVariablePopped I"));
  }
  SEDROP(m, 1);
  return MERROK;
}


void DBGRequestBreak(mmachine m, Brksrc brksrc) 
{
  // Ignore redundant break request
  if (debug.currState & (kVMIdle|kVMRunning)) {
    debug.lastState   = debug.currState;  // save current state
    debug.currState   = kVMIssuedBreak;
    debug.brksrc      = brksrc;
  }
}


static int DBGBreak(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  DBGRequestBreak(m, kBrksrcDebugger);
  return MERROK;
}


static int DBGResume(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  if (debug.currState == kVMSuspended) {
    debug.currState = kVMIssuedResume;
    debug.traceMode = kTraceNone;
    debug.traceFP   = 0;
  }
  return MERROK;
}


static int DBGRequestKill(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  debug.currState = kVMIssuedKill;
  return MERROK;
}


static int DBGKill(mmachine m)
{
  debug.currState = kVMKilled;
  int res;
  if ((res = DBGNotifyState(m)) && res != MERRDEBUG) // ignore debugger-related errors
    return res;
  debug.sock = 0;
  m->err = MERRCLOSE;
  return m->err;
}


static int DBGStep(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  if (debug.currState == kVMSuspended && Interpreter::current != 0) {
    debug.currState = kVMIssuedResume;
    debug.traceMode = kTraceStep;
    debug.traceFP   = Interpreter::current->getFP();
  }
  return MERROK;
}


static int DBGStepInto(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  if (debug.currState == kVMSuspended && Interpreter::current != 0) {
    debug.currState = kVMIssuedResume;
    debug.traceMode = kTraceStepInto;
    debug.traceFP   = 0;
  }
  return MERROK;
}


static int DBGStepOut(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  if (debug.currState == kVMSuspended && Interpreter::current != 0) {
    int32 callerFP;
    Interpreter::current->getCallStackRegisters(1, 0, &callerFP);
    if (callerFP == 0)
      return MERROK;
    debug.currState   = kVMIssuedResume;
    debug.traceMode   = kTraceStepOut;
    debug.traceFP     = callerFP;
  }
  return MERROK;
}


static int DBGSendState(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1);
  return DBGNotifyState(m);
}


static int DBGSendEnabledControlActions(mmachine m)
// [0] usually nil
{
  uint actions = 0;
 
  if (debug.currState & (kVMIdle|kVMRunning))  
    actions |= kActionBreak;                   // see DBGRequestBreak()
  else if (debug.currState & kVMSuspended) {
	  actions |= kActionResume;                // see DBGRequestResume()
    if (Interpreter::current != 0) {
	  actions |= kActionStep;                  // see DBGStep()
//$ Pending: Refine "Step Into" so that it applies only for function calls
	  actions |= kActionStepInto;              // see DBGStepInto()
      int32 callerFP;
      Interpreter::current->getCallStackRegisters(1, 0, &callerFP);
      if (callerFP != 0)
	    actions |= kActionStepOut;             // see DBGStepOut()
    }
  }
  if (debug.currState != kVMIssuedKill)
    actions |= kActionKill;                    // see DBGRequestKill()

  SESETTOP(m, 0, SEI2W(actions));
  return DBGSendMessage(m, 1, "enabledControlActions I");
}


static int DBGSendCallStack(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1); // drop unused argument

  // Do nothing if interpreter is not executing code
  // (See Note #1)
  if (!Interpreter::current)
    return MERROK;

  SECHECK(SEPUSH(m, NIL));
  int res;
  if (res = DBGSendMessage(m, 1, "callStackStart I"))
    return res;
  uint depth = 0;
  // Walk through call stack till bp is 0
  for (SEINT bp = Interpreter::current->getBP(); bp != 0; bp = SEW2I(SEGET(m, bp+OFFHBP))) {
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, bp+OFFHFUN)), OFFPVAR)));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFVPKG))); 
    SEINT i = SEGETSP(m);
    SECHECK(SEPUSH(m, SEI2W(depth)));
    SECHECK(SEPUSH(m, SEI2W(depth++)));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFPKID)));
    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFPKNAME)))))
      return res;
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFVID)));
    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFVNAME)))))
      return res;
    if (res = DBGSendMessage(m, 6, "callStackItem I I I S I S"))
      return res;
    SEDROP(m, 2);
  } // for
  SECHECK(SEPUSH(m, NIL));
  return DBGSendMessage(m, 1, "callStackEnd I");
}


static int DBGSendScript(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1); // drop unused argument
  int res;
  if (res = Mpushstrbloc(m, debug.script))
    return res;
  return DBGSendMessage(m, 1, "script S");
}


static int DBGSendLocalVariableList(mmachine m)
// [0] frame
{
  SEINT frame = SEW2I(SEPOP(m)); // positive frame depth (0 = current frame)

  // Do nothing if interpreter is not executing code
  // (See Note #1)
  if (!Interpreter::current)
    return MERROK;
  
  // Get specified frame bp and fp registers
  SEINT bp, fp;
  if (!Interpreter::getCallStackRegisters(frame, &bp, &fp))
    return MERROK;  // invalid frame depth

  // Save local variable list head
  SECHECK(SEPUSH(m, SEGET(m, bp+OFFHLOC)));
  SEINT i = SEGETSP(m);
  // Send list of local variables of the specified frame
  SECHECK(SEPUSH(m, SEI2W(frame)));
  SECHECK(DBGSendMessage(m, 1, "localVariableListStart I"));
  while (SEGET(m, i) != NIL) {
    SECHECK(SEPUSH(m, SEI2W(frame)));
    SEINT n = SEFETCH(m, SEW2P(SEGET(m, i)), DBG_LOC_INDEX);
    SECHECK(SEPUSH(m, n));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_LOC_NAME)));
    SECHECK(SEPUSH(m, SEGET(m, fp-SEW2I(n))));
    SECHECK(DBGPushValue(m));
    SECHECK(DBGSendMessage(m, 5, "localVariableListItem I I S S I"));
    SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_LOC_NEXT));
  } // while
  SESETTOP(m, 0, SEI2W(frame));
  return DBGSendMessage(m, 1, "localVariableListEnd I");
}


static int DBGSendLocalVariableValue(mmachine m)
// [1] frame depth
// [0] variable index
{
  SEINT index = SEW2I(SEPOP(m)); // variable index
  SEINT frame = SEW2I(SEPOP(m)); // frame depth

  // Do nothing if interpreter is not executing code
  // (See Note #1)
  if (!Interpreter::current)
    return MERROK;

  // Get specified frame bp and fp registers
  SEINT fp;
  if (!Interpreter::getCallStackRegisters(frame, 0, &fp))
    return MERROK;  // invalid frame index

  SECHECK(SEPUSH(m, SEI2W(frame)));
  SECHECK(SEPUSH(m, SEI2W(index)));
  SECHECK(SEPUSH(m, SEGET(m, fp-index)));
  SECHECK(DBGPushValue(m));
  SECHECK(DBGSendMessage(m, 4, "localVariableValue I I S I"));
  return MERROK;
}


static int DBGSendCurrentChannel(mmachine m)
// Send current channel information
{
  int res;
  SEDROP(m, 1); // drop unused argument
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCUR)));
  if (res = DBGPushChannelInfo(m, SEGETSP(m)))
    return res;
  if (res = DBGSendMessage(m, 3, "currentChannel I S S"))
    return res;
  SEDROP(m, 1);
  return MERROK;
}


static int DBGSendChannelList(mmachine m)
// Send the list of all active (opened) channels
// [0] usually nil
{
  int res;
  SEDROP(m, 1);  // drop unused argument
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCCHAN)));
  SECHECK(SEPUSH(m, NIL));
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, NIL));
  if (res = DBGSendMessage(m, 1, "channelListStart I"))
    return res;
  while (SEGET(m, i+1) != NIL) {
    SESET(m, i, SEHEAD(m, SEW2P(SEGET(m, i+1))));
    if (res = DBGPushChannelInfo(m, i))
      return res;
    if (res = DBGSendMessage(m, 3, "channelListItem I S S"))
      return res;
    SESET(m, i+1, SETAIL(m, SEW2P(SEGET(m, i+1))));
  } // while
  SEDROP(m, 1);
  SESETTOP(m, 0, NIL);
  return DBGSendMessage(m, 1, "channelListEnd I");
}


static int DBGSendBasePackageList(mmachine m)
// Send base environment
// [0] usually nil
{
  int res;
  SEDROP(m, 1); // drop unused argument
  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCBASE)));
  SECHECK(SEPUSH(m, NIL));
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, NIL));
  if (res = DBGSendMessage(m, 1, "basePackageListStart I"))
    return res;
  while (SEGET(m, i+1) != NIL) {
    SESET(m, i, SEHEAD(m, SEW2P(SEGET(m, i+1))));
    if (res = DBGPushPackageInfo(m, i))
      return res;
	  if (res = DBGSendMessage(m, 3, "basePackageListItem I S I"))
	    return res;
    SESET(m, i+1, SETAIL(m, SEW2P(SEGET(m, i+1))));
  } // while
  SEDROP(m, 1);
  SESETTOP(m, 0, NIL);
  return DBGSendMessage(m, 1, "basePackageListEnd I");
}


static SEWORD DBGFindChannel(mmachine m, SEWORD chnID)
// Search for a channel with the given channel id
{
  for (SEWORD l = SEGETROOT(m, OFFSCCHAN); l != NIL; l = SETAIL(m, SEW2P(l))) {
    SEWORD chn = SEHEAD(m, SEW2P(l));
    if (SEFETCH(m, SEW2P(chn), OFFCHANID) == chnID)
      return chn;
  }
  return NIL;
}


static int DBGSendPackageList(mmachine m)
// Send channel environment
// [0] channel id for which to list packages
{
  SEWORD chnID = SEPOP(m);
  if (chnID == NIL)
    return MERROK;  // channel id is null
  SEWORD chn = DBGFindChannel(m, chnID);
  if (chn == NIL)
    return MERROK;  // channel id is invalid

  SECHECK(SEPUSH(m, SEGETROOT(m, OFFSCBASE)));
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(chn), OFFCHANENV)));
  SECHECK(SEPUSH(m, NIL));
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, chnID));
  int res;
  if (res = DBGSendMessage(m, 1, "packageListStart I"))
    return res;
  // We list only those packages that do not belong to the base environment
  while (SEGET(m, i+1) != NIL && SEGET(m, i+1) != SEGET(m, i+2)) {
    SESET(m, i, SEHEAD(m, SEW2P(SEGET(m, i+1))));
    SECHECK(SEPUSH(m, chnID));                                     // channel id
    if (res = DBGPushPackageInfo(m, i))
      return res;
    if (res = DBGSendMessage(m, 4, "packageListItem I I S I"))
	    return res;
    SESET(m, i+1, SETAIL(m, SEW2P(SEGET(m, i+1))));
  } // while
  SEDROP(m, 2);
  SESETTOP(m, 0, chnID);
  return DBGSendMessage(m, 1, "packageListEnd I");
}


static SEWORD DBGFindPackage(mmachine m, SEWORD chnID, SEWORD pkgID)
{
  SEWORD chn = DBGFindChannel(m, chnID); 
  if (chn != NIL) {
	  for (SEWORD l = SEFETCH(m, SEW2P(chn), OFFCHANENV); l != NIL; l = SETAIL(m, SEW2P(l))) {
      SEWORD pkg = SEHEAD(m, SEW2P(l));
      if (SEFETCH(m, SEW2P(pkg), OFFPKID) == pkgID)
        return pkg;
    } // for
  } // if
  return NIL;
}


static int DBGSendVariableList(mmachine m)
// Send list of package variables
// [1] channel id
// [0] package id
{
  SEWORD pkgID = SEPOP(m);
  SEWORD chnID = SEPOP(m);
  if (pkgID == NIL || chnID == NIL)
    return MERROK;   // channel and/or package id is/are null
  SEWORD pkg = DBGFindPackage(m, chnID, pkgID);
  if (pkg == NIL)
    return MERROK;  // channel and/or package id is/are invalid

  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(pkg), OFFPKINTRN))); // package dictionary
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, chnID));
  SECHECK(SEPUSH(m, pkgID));
  int res;
  if (res = DBGSendMessage(m, 2, "variableListStart I I"))
    return res;
  while (SEGET(m, i) != NIL) {
    if (SEW2I(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVTYP)) == TYPVAR) {
      SECHECK(SEPUSH(m, chnID));                                  // channel id
      SECHECK(SEPUSH(m, pkgID));                                  // package id
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVID))); // variable id
	    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNAME)))))
	      return res;                                               // variable name
	    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVSTYP)))))
	      return res;                                               // variable type string
	    if (res = DBGSendMessage(m, 5, "variableListItem I I I S S"))
	      return res;
    } // if
    SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNEXT));
  } // while
  SESETTOP(m, 0, chnID);
  SECHECK(SEPUSH(m, pkgID));
  return DBGSendMessage(m, 2, "variableListEnd I I");
}


static int DBGSendFunctionList(mmachine m)
// Send list of package functions
// [1] channel id
// [0] package id
{
  SEWORD pkgID = SEPOP(m);
  SEWORD chnID = SEPOP(m);
  if (pkgID == NIL || chnID == NIL)
    return MERROK;   // channel and/or package id is/are null
  SEWORD pkg = DBGFindPackage(m, chnID, pkgID);
  if (pkg == NIL)
    return MERROK;  // channel and/or package id is/are invalid

  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(pkg), OFFPKINTRN))); // package dictionary
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, chnID));
  SECHECK(SEPUSH(m, pkgID));
  int res;
  if (res = DBGSendMessage(m, 2, "functionListStart I I"))
    return res;
  while (SEGET(m, i) != NIL) {
    if (SEW2I(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVTYP)) >= 0) {
      SECHECK(SEPUSH(m, chnID));                                    // channel id
      SECHECK(SEPUSH(m, pkgID));                                    // package id
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVID)));   // function id
	    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNAME)))))
	      return res;                                                 // function name
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVTYP)));  // function arity
	    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVSTYP)))))
	      return res;                                                 // function type string
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVSIZE))); // function size      
	    if (res = DBGSendMessage(m, 7, "functionListItem I I I S I S I"))
	      return res;
    } // if
    SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNEXT));
  } // while
  SESETTOP(m, 0, chnID);
  SECHECK(SEPUSH(m, pkgID));
  return DBGSendMessage(m, 2, "functionListEnd I I");
}


static int DBGFindObject(mmachine m, SEWORD chnID, SEWORD pkgID, SEWORD objID)
{
  SEWORD pkg = DBGFindPackage(m, chnID, pkgID);
  if (pkg != NIL)
    for (SEWORD obj = SEFETCH(m, SEW2P(pkg), OFFPKINTRN); obj != NIL; 
         obj = SEFETCH(m, SEW2P(obj), OFFVNEXT))
	    if (SEFETCH(m, SEW2P(obj), OFFVID) == objID)
	      return obj;
  return NIL;
}


static int DBGLockPointer(mmachine m)
// [0] SCOL pointer to lock
{
  static SEINT ptrID = 0;  // pointer id count

  // If pointer is already locked, return its id
  for (SEWORD ptr = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS); ptr != NIL;
       ptr = SEFETCH(m, SEW2P(ptr), DBG_PTR_NEXT))
    if (SEFETCH(m, SEW2P(ptr), DBG_PTR_VAL) == SEGETTOP(m, 0)) {
      SESETTOP(m, 0, SEFETCH(m, SEW2P(ptr), DBG_PTR_ID));
      return MERROK;
    } // if
  // Register locked pointer
  SECHECK(SEPUSH(m, SEI2W(ptrID)));
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS)));
  SECHECK(SEPUSH(m, SEI2W(DBG_PTR_SIZE)));
  SECHECK(SENEWTUPLE(m));
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS, SEPOP(m));
  // Return pointer id and increment pointer count
  SECHECK(SEPUSH(m, SEI2W(ptrID++)));
  return MERROK;
}


static int DBGPushValue(mmachine m)
// [0] value
{
  SEWORD val = SEPOP(m);
  int res;
  if (val == NIL) {
    if (res = Mpushstrbloc(m, "nil"))
      return res;
    SECHECK(SEPUSH(m, NIL));
  } else if (SEISPTR(val)) {           // pointer to heap block
    uint type = SEBLKTYPE(m, SEW2P(val));
    SECHECK(SEPUSH(m, val));
    if (res = DBGLockPointer(m))
      return res;
    if (res = Mpushstrbloc(m, type == SETYPETUPLE ? "tuple" : "buffer"))
      return res;
    SESWAP(m);
  } else {
    SECHECK(SEPUSH(m, val));
    if (res = Mpushstrbloc(m,  "int")) // integral (deprecated)
	    return res;
    SESWAP(m);
  }
  return MERROK;
}


static int DBGSendVariableValue(mmachine m)
// [2] channel id
// [1] package id
// [0] variable id
{
  SEWORD varID = SEPOP(m);
  SEWORD pkgID = SEPOP(m);
  SEWORD chnID = SEPOP(m);
  if (varID == NIL || pkgID == NIL || chnID == NIL)
    return MERROK;
  SEWORD var = DBGFindObject(m, chnID, pkgID, varID);
  if (var == NIL)
    return MERROK; // invalid channel id and/or package id and/or variable id
  if (SEW2I(SEFETCH(m, SEW2I(var), OFFVTYP)) != TYPVAR)
    return MERROK; // object is not a variable
  SECHECK(SEPUSH(m, var));   // save on the stack the variable definition
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, chnID)); // channel id
  SECHECK(SEPUSH(m, pkgID)); // package id
  SECHECK(SEPUSH(m, varID)); // variable id
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVVAL)));
  int res;
  if (res = DBGPushValue(m)) // value (raw)
    return res;
  if (res = DBGSendMessage(m, 5, "variableValue I I I S I"))
	  return res;
  SEDROP(m, 1);
  return MERROK;
}


static int DBGSendStackTop(mmachine m)
// [0] usually nil
{
//if (!m->h)
//  return MERROK;  // does not apply
  SESETTOP(m, 0, SEGETTOP(m, 1)); // use value before top
  int res;
  if (res = DBGPushValue(m))
    return res;
  return DBGSendMessage(m, 2, "stackTop S I");
}


static int DBGSendSourcePosition(mmachine m)
// [0] frame
{
  SEINT frame = SEW2I(SEPOP(m)); // frame index (0 = current frame)
  int res;
  if (frame == 0 && debug.scriptBegLine > 0) {
    SECHECK(SEPUSH(m, NIL));     // to account for position pushed in else part
    SECHECK(SEPUSH(m, SEI2W(0)));
    SECHECK(SEPUSH(m, NIL));
    if (res = Mpushstrbloc(m, "<script>"))
      return res;
    SECHECK(SEPUSH(m, SEI2W(debug.scriptBegLine)));
    SECHECK(SEPUSH(m, SEI2W(debug.scriptBegOff)));
    SECHECK(SEPUSH(m, SEI2W(debug.scriptEndLine)));
    SECHECK(SEPUSH(m, SEI2W(debug.scriptEndOff)));
    SECHECK(SEPUSH(m, SEI2W(kEvalBefore)));
    SECHECK(SEPUSH(m, NIL));
  } else {
    // Do nothing if interpreter is not executing code
    // (See Note #1)
    if (!Interpreter::current)
      return MERROK;

    // Get specified frame's bp and fp register values
    SEINT bp;
    if (!Interpreter::getCallStackRegisters(frame, &bp, 0))
      return MERROK;         // invalid frame depth

    SECHECK(SEPUSH(m, SEGET(m, bp+OFFHPOS)));
    SEINT i = SEGETSP(m);
    SECHECK(SEPUSH(m, SEI2W(frame)));
    if (SEGET(m, i) == NIL)  // no information available
      for (int j = 0; j < 8; j++)
	    SECHECK(SEPUSH(m, NIL));
    else {
      SEPTR var = SEFETCH(m, SEW2P(SEGET(m, bp+OFFHFUN)), OFFPVAR);
      SEPTR pkg = SEFETCH(m, SEW2P(var), OFFVPKG);
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(pkg), OFFPKID))); // package id
      if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(pkg), OFFPKNAME)))))
        return res;                                        // package name
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_BEGLINE)));
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_BEGOFF)));
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_ENDLINE)));
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_ENDOFF)));
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_EVAL)));
      SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BPT_EXPCLASS)));
    }
  }
  if (res = DBGSendMessage(m, 9, "sourcePosition I I S I I I I I I"))
    return res;
  SEDROP(m, 1);
  return MERROK;
}


static int DBGSendFileContents(mmachine m)
// [0] filename
{
  SECHECK(SEDUP(m));
  // A bit inefficient: I use library function _getpack
  int res;
  if (res = SPcheckpack(m))
    return res;
  if (SEGETTOP(m, 0) == NIL) {
    SEDROP(m, 2);
    return MERROK; // not a file
  }
  if (res = SPgetpack(m))
    return res;
  if (SEGETTOP(m, 0) == NIL) {
	SEDROP(m, 2);
    return MERROK;
  }
  SEINT i      = SEGETSP(m);
  SEINT size   = SESTRLEN(m, SEW2P(SEGET(m, i)));
  SEINT blocks = size/DEBUG_BLOCK_SIZE+(size%DEBUG_BLOCK_SIZE > 0);
  // Send file size (in bytes and blocks) to debugger server
  SECHECK(SEPUSH(m, SEGET(m, i+1)));
  SECHECK(SEPUSH(m, SEI2W(size)));
  SECHECK(SEPUSH(m, SEI2W(blocks)));
  if (res = DBGSendMessage(m, 3, "fileSize S I I"))
    return res;
  // Send file blocks
  for (int off = 0; blocks-- > 0; off += DEBUG_BLOCK_SIZE) {
	SECHECK(SEPUSH(m, SEGET(m, i+1)));
    int n = (blocks == 0) ? size%DEBUG_BLOCK_SIZE : DEBUG_BLOCK_SIZE;
	if (res = Mpushstrblocn(m, SESTR(m, SEW2P(SEGET(m, i)))+off, n))
      return res;
    if (res = DBGSendMessage(m, 2, "fileBlock S S"))
	  return res;
  } // for
  SEDROP(m, 2);
  return MERROK;
}


static int DBGFindPointer(mmachine m, SEWORD ptrID)
{
  for (SEWORD ptr = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS); ptr != NIL;
       ptr = SEFETCH(m, SEW2P(ptr), DBG_PTR_NEXT))
    if (SEFETCH(m, SEW2P(ptr), DBG_PTR_ID) == ptrID)
      return SEFETCH(m, SEW2P(ptr), DBG_PTR_VAL);
  return NIL;
}


static int DBGSendTupleElements(mmachine m)
// [0] pointer id of tuple
{
  SEWORD ptrID = SEPOP(m);
  SEWORD ptr   = DBGFindPointer(m, ptrID);
  if (ptr == NIL)
    return MERROK; // invalid pointer id
  SECHECK(SEPUSH(m, ptr));
  SEINT i = SEGETSP(m);
  // Send tuple size as heading
  SECHECK(SEPUSH(m, ptrID));
  SEINT size = SEBLKSIZE(m, SEW2P(SEGET(m, i)));
  SECHECK(SEPUSH(m, SEI2W(size)));
  int res;
  if (res = DBGSendMessage(m, 2, "tupleSize I I"))
    return res;
  // Send tuple contents
  for (int k = 0; k < size; k++) {
    SECHECK(SEPUSH(m, ptrID));                              // pointer id
    SECHECK(SEPUSH(m, SEI2W(k)));                           // tuple element index
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), k)));
    if (res = DBGPushValue(m))                              // tuple element value
	    return res;
	  if (res = DBGSendMessage(m, 4, "tupleElement I I S I"))
	    return res;
  } // for
  SEDROP(m, 1);
  return MERROK;
}


static int DBGSendBufferContents(mmachine m)
// [1] pointer id of buffer
// [0] preview? (send at most one block)
{
  SEINT  preview = SEW2I(SEPOP(m));
  SEWORD ptrID   = SEPOP(m);
  SEWORD ptr     = DBGFindPointer(m, ptrID);
  if (ptr == NIL)
    return MERROK;  // invalid pointer id
  SECHECK(SEPUSH(m, ptr));
  SEINT i = SEGETSP(m);
  // Send buffer size as heading
  SECHECK(SEPUSH(m, ptrID));             // pointer id
  SEINT size = SEBLKSIZE(m, SEW2P(SEGET(m, i)))*sizeof(SEWORD);
  SECHECK(SEPUSH(m, SEI2W(size)));       // buffer size in bytes
  SEINT blocks = size/DEBUG_BLOCK_SIZE+(size%DEBUG_BLOCK_SIZE > 0);
  SECHECK(SEPUSH(m, SEI2W(blocks)));     // buffer size in blocks
  int res;
  if (res = DBGSendMessage(m, 3, "bufferSize I I I"))
    return res;
  // Send buffer contents
  if (preview)
    blocks = 1; // only 1 block if preview is true
  SEINT off = 0;
  for (SEINT k = 0; k < blocks; k++) {
    SECHECK(SEPUSH(m, ptrID));
    if (res = Mpushstrblocn(m, SECSTR(m, SEW2P(SEGET(m, i)))+off, 
                (k == blocks-1) ? size%DEBUG_BLOCK_SIZE : DEBUG_BLOCK_SIZE))
      return res;
    if (res = DBGSendMessage(m, 2, "bufferBlock I S"))
      return res;
    off += DEBUG_BLOCK_SIZE;
  } // for
  SEDROP(m, 1);
  return MERROK;
}


static int DBGUnlockPointer(mmachine m)
// [0] pointer id of pointer to unlock
{
  SEWORD ptrID = SEPOP(m);
  SEWORD cur   = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS);
  if (cur == NIL)  
    return MERROK;  // no pointers locked
  SEWORD prv = NIL;
  SEPTR  p;
  do {
	  p = SEW2P(cur);
    if (SEFETCH(m, p, DBG_PTR_ID) == ptrID) {
      // Remove pointer from list to unlock it
	    if (prv == NIL)
        SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS, SEFETCH(m, p, DBG_PTR_NEXT));
	    else
        SESTORE(m, SEW2P(prv), DBG_PTR_NEXT, SEFETCH(m, p, DBG_PTR_NEXT));
	    return MERROK;
    } // if
    prv = cur;
  } while ((cur = SEFETCH(m, p, DBG_PTR_NEXT)) != NIL);

  return MERROK; // no pointer found
}


static int DBGUnlockAllPointers(mmachine m)
// [0] usually nil
{
  SEDROP(m, 1); // drop unused argument
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_PTRS, NIL);
  return MERROK;
}


static int DBGAddBreakpoint (mmachine m, SEWORD chnID, SEWORD pkgID, SEWORD funID)
// [0] function pointer (PB)
{
  static SEINT bptID = 0;  // breakpoint id count
  // Take current channel id if chnID is null
  if (chnID == NIL)
    chnID = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCCUR)), OFFCHANID);
  // Precond: funID == NIL implies pkgID == NIL
  SEWORD fun;
  if (funID == NIL) {
    fun   = SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFPVAR);
    funID = SEFETCH(m, SEW2P(fun), OFFVID);
  }
  if (pkgID == NIL) 
    pkgID = SEFETCH(m, SEW2P(SEFETCH(m, SEW2P(fun), OFFVPKG)), OFFPKID);
  // Add breakpoint to the head of the list
  SECHECK(SEDUP(m));
  SECHECK(SEPUSH(m, SEI2W(bptID)));
  SECHECK(SEPUSH(m, chnID));
  SECHECK(SEPUSH(m, pkgID));
  SECHECK(SEPUSH(m, funID));
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS)));
  SECHECK(SEPUSH(m, SEI2W(DBG_BRKPT_SIZE)));
  SECHECK(SENEWTUPLE(m));
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS, SEPOP(m));
  // Notify debugger server (if online) that a new breakpoint has been recorded
  if (debug.sock) {
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFPVAR)));
    SEINT i = SEGETSP(m);
    SECHECK(SEPUSH(m, SEI2W(bptID)));
    SECHECK(SEPUSH(m, chnID));
    SECHECK(SEPUSH(m, pkgID));
    int res;
    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, 
        SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVPKG)), OFFPKNAME)))))
      return res;
    SECHECK(SEPUSH(m, funID));
    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNAME)))))
      return res;
    if (res = DBGSendMessage(m, 6, "breakpointAdded I I I S I S"))
      return res;
    SEDROP(m, 1);
  } // if
  SEDROP(m, 1);
  bptID++;
  return MERROK;
}


static int DBGSetBreakpoint(mmachine m)
// [2] channel id
// [1] package id
// [0] function id
{
  SEWORD funID = SEPOP(m);
  SEWORD pkgID = SEPOP(m);
  SEWORD chnID = SEPOP(m);
  SEWORD fun   = DBGFindObject(m, chnID, pkgID, funID);
  if (fun == NIL)
    return MERROK;  // invalid channel id and/or package id and/or function id
  if (SEW2I(SEFETCH(m, SEW2P(fun), OFFVTYP)) < 0)
    return MERROK;  // object is not a function 
  SEWORD pb = SEFETCH(m, SEW2P(fun), OFFVVAL);
  if (SEW2I(SEFETCH(m, SEW2P(pb), OFFPDBG)))
    return MERROK;  // breakpoint already set
  // Set trace flag
  SESTORE(m, SEW2P(pb), OFFPDBG, SEI2W(1));
  // Register breakpoint
  SECHECK(SEPUSH(m, pb));
  return DBGAddBreakpoint(m, chnID, pkgID, funID);
}


static int DBGSendBreakpointList(mmachine m)
// [1] channel id
// [0] package id
{
  SEWORD pkgID = SEPOP(m);
  SEWORD chnID = SEPOP(m);
  SEWORD bpt   = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS);

  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, bpt)); // save breakpoint list head
  SEINT i = SEGETSP(m);
  SECHECK(SEPUSH(m, NIL));
  int res;
  if (res = DBGSendMessage(m, 1, "breakpointListStart I"))
    return res;
  while (SEGET(m, i) != NIL) {
	  // List only those breakpoints associated to the given channel and/or package
    if (chnID != NIL
    && (SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_CHNID) != chnID
		  || pkgID != NIL 
		    && SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_PKGID) != pkgID)) {
      SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_NEXT));
	    continue;
    }
    SESET(m, i+1, SEFETCH(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_PB)), OFFPVAR));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_ID)));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_CHNID)));
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_PKGID)));
    if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEFETCH(m, 
        SEW2P(SEGET(m, i+1)), OFFVPKG)), OFFPKNAME)))))
      return res;
    SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_FUNID)));
	  if (res = Mpushstrbloc(m, SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFVNAME)))))
	    return res;
    if (res = DBGSendMessage(m, 6, "breakpointListItem I I I S I S"))
	    return res;
    SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), DBG_BRKPT_NEXT));
  } // while
  SEDROP(m, 1);
  SESETTOP(m, 0, NIL);
  return DBGSendMessage(m, 1, "breakpointListEnd I");
}


static int DBGFindBreakpoint(mmachine m, SEWORD bptID)
{
  for (SEWORD bpt = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS);
       bpt != NIL;
       bpt = SEFETCH(m, SEW2P(bpt), DBG_BRKPT_NEXT))
    if (SEFETCH(m, SEW2P(bpt), DBG_BRKPT_ID) == bptID)
      return bpt;
  return NIL; // not found
}


static int DBGRemoveBreakpoint(mmachine m)
// [0] breakpoint id
{
  SEWORD bptID = SEGETTOP(m, 0);
  SEWORD bpt = DBGFindBreakpoint(m, bptID);
  if (bpt == NIL)
    return MERROK; // invalid breakpoint id
  // Clear trace flag
  SESTORE(m, SEW2P(SEFETCH(m, SEW2P(bpt), DBG_BRKPT_PB)), OFFPDBG, SEI2W(0));
  // Remove breakpoint from list
  SEWORD cur = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS);
  SEWORD prv = NIL;
  SEPTR  p;
  do {
	  p = SEW2P(cur);
	  if (cur == bpt) {
	    if (prv == NIL)
        SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS, SEFETCH(m, p, DBG_BRKPT_NEXT));
	    else
        SESTORE(m, SEW2P(prv), DBG_BRKPT_NEXT, SEFETCH(m, p, DBG_BRKPT_NEXT));
	    break;
    } // if
    prv = cur;
  } while ((cur = SEFETCH(m, p, DBG_BRKPT_NEXT)) != NIL);
  // Notify debugger server (stack top holds id)
  return DBGSendMessage(m, 1, "breakpointRemoved I");
}


static int DBGRemoveAllBreakpoints(mmachine m)
// [0] usually nil
{
  SEWORD bpt = SEFETCH(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS);
  SEINT  cnt = 0;
  // Deactivate all breakpoints
  while (bpt != NIL) {
	// Clear trace flag
    SESTORE(m, SEW2P(SEFETCH(m, SEW2P(bpt), DBG_BRKPT_PB)), OFFPDBG, SEI2W(0));
    bpt = SEFETCH(m, SEW2P(bpt), DBG_BRKPT_NEXT);
    cnt++;
  } // while
  // Set breakpoint list to nil
  SESTORE(m, SEW2P(SEGETROOT(m, OFFSCDEBUG)), DBG_BRKPTS, NIL);
  // Notify debugger server
  SESETTOP(m, 0, SEI2W(cnt));
  return DBGSendMessage(m, 1, "allBreakpointsRemoved I");
}


int DBGAddBPT(mmachine m, int ind, uint32 off, const TextSpan& span, DBGEvalTime eval)
{  
  // Position is registered if it's unique
  SEWORD bpt = SEGET(m, ind+PKGBPT);
  while (bpt != NIL) {
	SEPTR p = SEW2P(bpt);
	if (SEW2I(SEFETCH(m, p, DBG_BPT_BEGOFF)) == (SEINT)span.beg.off
	 && SEW2I(SEFETCH(m, p, DBG_BPT_ENDOFF)) == (SEINT)span.end.off
	 && SEW2I(SEFETCH(m, p, DBG_BPT_EVAL))   == eval)
	  return MERROK;
	bpt = SEFETCH(m, p, DBG_BPT_NEXT);
  } // while

  // Add breakpoint into BPT list
  SECHECK(SEPUSH(m, SEI2W(off)));
  SECHECK(SEPUSH(m, SEI2W(span.beg.line)));
  SECHECK(SEPUSH(m, SEI2W(span.beg.off)));
  SECHECK(SEPUSH(m, SEI2W(span.end.line)));
  SECHECK(SEPUSH(m, SEI2W(span.end.off)));
  SECHECK(SEPUSH(m, SEI2W(eval)));
  SECHECK(SEPUSH(m, NIL));
  SECHECK(SEPUSH(m, SEGET(m, ind+PKGBPT)));
  SECHECK(SEPUSH(m, SEI2W(DBG_BPT_SIZE)));
  SECHECK(SENEWTUPLE(m));
  SESET(m, ind+PKGBPT, SEPOP(m));
  //MMechostr(MSKTRACE, "BPT offset %d: span (%d, %d) - (%d, %d)\n", off,
  //  span.beg.line, span.beg.off, span.end.line, span.end.off);
  return MERROK;
}


static SEWORD DBGFindBPT(mmachine m, uint32 brkOff)
// Search for BPT list pointer from current PB and break offset
{
//assert(Interpreter::current != 0);
  SEWORD bpt, apprBpt;
  uint32 apprOff = 0;
  for (bpt = SEFETCH(m, SEW2P(SEGET(m, Interpreter::current->getBP()+OFFHFUN)), OFFPBPT);
       bpt != NIL;
       bpt = SEFETCH(m, SEW2P(bpt), DBG_BPT_NEXT)) {
	uint32 off = SEW2I(SEFETCH(m, SEW2P(bpt), DBG_BPT_BRKOFF));
    if (off == brkOff) {
      //MMechostr(MSKTRACE, "At BPT offset %d\n", off); 
	  return bpt;
    }
    // Approximate offset to (strict) least upper bound
    if (off > brkOff && (!apprOff || off < apprOff)) {
      //MMechostr(MSKTRACE, "At BPT offset %d (approximated)\n", apprOff); 
	  apprBpt = bpt;
	  apprOff = off;
	}
  }
  return !apprOff ? NIL : apprBpt;
}


void DBGUpdatePosition(mmachine m, uint32 brkOff)
{
//assert(Interpreter::current != 0);
  SEWORD bpt = DBGFindBPT(m, brkOff);
  if (bpt == NIL)
    MMechostr(MSKTRACE, "debug: no BPT found!\n"); // should never happen
  debug.scriptBegLine = 0;
  debug.scriptBegOff  = 0;
  debug.scriptEndLine = 0;
  debug.scriptEndOff  = 0;
  SESET(m, Interpreter::current->getBP()+OFFHPOS, bpt);
}



static struct {
  const char* keyword;         // message keyword
  int (*function)(mmachine);   // message function
} actions[] = {
	// Handling of control actions
	{ "break",                    DBGBreak                     },
	{ "resume",                   DBGResume                    },
	{ "step",                     DBGStep                      },
 	{ "stepInto",                 DBGStepInto                  },
    { "stepOut",                  DBGStepOut                   },
	{ "kill",                     DBGRequestKill               },
	/* Context and state information */
	{ "getState",                 DBGSendState                 },
	{ "getEnabledControlActions", DBGSendEnabledControlActions },
	{ "getCallStack",             DBGSendCallStack             },
	{ "getSourcePosition",        DBGSendSourcePosition        },
	{ "getFileContents",          DBGSendFileContents          },
	{ "getScript",                DBGSendScript                },
	{ "getLocalVariableList",     DBGSendLocalVariableList     },
	{ "getLocalVariableValue",    DBGSendLocalVariableValue    },
	{ "getStackTop",              DBGSendStackTop              },
	{ "getCurrentChannel",        DBGSendCurrentChannel        },
	/* Environment information */
	{ "getChannelList",           DBGSendChannelList           },
	{ "getBasePackageList",       DBGSendBasePackageList       },
	{ "getPackageList",           DBGSendPackageList           },
	{ "getVariableList",          DBGSendVariableList          },
	{ "getVariableValue",         DBGSendVariableValue         },
	{ "getFunctionList",          DBGSendFunctionList          },
	/* Breakpoints */
	{ "getBreakpointList",        DBGSendBreakpointList        },
	{ "setBreakpoint",            DBGSetBreakpoint             },
	{ "removeBreakpoint",         DBGRemoveBreakpoint          },
	{ "removeAllBreakpoints",     DBGRemoveAllBreakpoints      },
	/* Value exploration */
	{ "getTupleElements",         DBGSendTupleElements         },
	{ "getBufferContents",        DBGSendBufferContents        },
	{ "unlockPointer",            DBGUnlockPointer             },
	{ "unlockAllPointers",        DBGUnlockAllPointers         }
};


// Message arguments are already pushed into the stack
static int DBGHandleMessage(mmachine m, const char* keyword) 
{
  for (int i = 0; i < sizeof(actions)/sizeof(actions[0]); i++)
    if (!strcmp(keyword, actions[i].keyword))
	    return (*actions[i].function)(m);

  MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGILLSERVICE"\n", keyword);
  return MERROK;
}


int DBGRead(mmachine m, int sock, char* buf, int len)
{
  static unsigned int st = 0; // input state
  static unsigned int in = 0; // input position
  static char inbuf[1024];    // input buffer
 
  if (debug.sock == sock) {
	  int i;
    for (i = 0; i < len; i++) {
      inbuf[in++] = buf[i];
      inbuf[in]   = '\0';
      switch (st) {
	      case 0: // state 0: expecting size byte #1
		      st = 1;
		      break;
		    case 1: // state 1: expecting size byte #2
		      st = 2;
		      break;
		    case 2: // state 2: expecting any character (null resets reader to state 0)
		      if (!buf[i]) {
		        unsigned int n = inbuf[0]+(((int)inbuf[1])<<8);
		        int nwords;
            char* words[128];
            MMechostr(MSKTRACE, "Read %d bytes: '%s'\n", n, inbuf+2);

	          // Interpret the words as arguments and push them into the stack
	          if ((nwords = Mcutting(inbuf+2, words)) > 1) {
	            int j;
	            for (j = 1; j < nwords; j++) {
	              char* arg = words[j];
		            if (!strcmp(arg, "NIL")) {
		              SECHECK(SEPUSH(m, NIL));
                } else if (arg[0] == '"') {
		              arg[strlen(arg)-1] = '\0';
		              if (Mpushstrbloc(m, arg+1))
// Error should be propagated to caller
		                SECHECK(SEPUSH(m, NIL));
                } else {
                  int n;
                  h2i(arg, &n);
	                SECHECK(SEPUSH(m, SEI2W(n)));
                }
              }
	            // Select appropriate action
	            if (DBGHandleMessage(m, words[0]))
	              MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGREQUEST"\n");
            }
			      // Reset reader
			      st = in = 0;
          }
		      break;
      } // switch
    } // for
	  return TRUE;
  } // if
  return FALSE;
}


static int DBGSyncRead(mmachine m)
{
  if (WSAAsyncSelect(debug.sock, hscol, 0, 0)) {
    MMechostr(MSKTRACE, "(!) "MSGEDEBUGMODESWITCH"\n");
	  return MERRDEBUG;
  }

  fd_set rf;
  FD_ZERO(&rf);
  FD_SET(debug.sock, &rf);
  int res;
  if ((res = select(0, &rf, NULL, NULL, NULL)) == 1) {
    char buf[DEBUG_BUFFER_SIZE];
    if ((res = recvfrom((SOCKET)debug.sock, buf, DEBUG_BUFFER_SIZE, 0, NULL, NULL)) > 0)
      DBGRead(m, debug.sock, buf, res);
//$$ Propagate errors from DBGRead()
	  else {
	    if (res == SOCKET_ERROR) {
		    if ((res = WSAGetLastError()) != WSAEWOULDBLOCK)
	        MMechostr(MSKRUNTIME, "(!)"MSGEDEBUGSOCKET"\n", res);
//$ Ignore socket errors?
      } else if (res == 0) {
	      MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGSERVERDOWN"\n");
		    debug.sock = 0;
	      return MERRDEBUG;
      }
    }
	  if (res == SOCKET_ERROR) {
      MMechostr(MSKRUNTIME, "(!)"MSGEDEBUGSOCKET"\n", WSAGetLastError());
	    debug.sock = 0;
	    return MERRDEBUG;
    }
  }
  if (WSAAsyncSelect(debug.sock, hscol, WSA_ASYNC, FD_ACCEPT|FD_READ|FD_WRITE|FD_CLOSE)) {
    MMechostr(MSKTRACE, "(!) "MSGEDEBUGMODESWITCH"\n");
	  return MERRDEBUG;
  }
  return MERROK;
}


// Handle break and kill control requests
int DBGHandleBreak(mmachine m)
{
  int res;
		  
  if (!debug.sock)
    return MERROK;

  // Handle kill request
  if (debug.currState == kVMIssuedKill)
    return DBGKill(m);

  if (debug.currState != kVMIssuedBreak)
	  return MERROK;

  if (Interpreter::current != 0 
    && (debug.brksrc == kBrksrcDebugger
      || debug.brksrc == kBrksrcUserAssert
      || debug.brksrc == kBrksrcUserBreak)) {
    // Break at a meaningful place
    SEPTR p   = SEW2P(SEGET(m, Interpreter::current->getBP()+OFFHCODE));
    int32 off = Interpreter::current->getPC()-ALIGNMENT(1);
    if (!(((byte*)SEBEG(m, p))[off] == kDebug))
      return MERROK;
    DBGUpdatePosition(m, off);
  }

  // Handle break request
  debug.currState = kVMSuspended;
  if (res = DBGNotifyState(m))
    goto end;

  // Service debugger until resume or kill is requested
  for (;;) {
    if (res = DBGSyncRead(m))
	    goto end;
    if (debug.currState == kVMIssuedResume) {
	    debug.currState = debug.lastState;
	    debug.lastState = kVMUnknown;
      if (res = DBGNotifyState(m))
	      goto end;
	    return MERROK;
    }
    if (debug.currState == kVMIssuedKill)
      return DBGKill(m);
  } // for

end:
  if (res == MERRDEBUG) {
    MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGCLOSING"\n");
    return MERRCLOSE;
  }
  return res;
}


int DBGServiceDebugger(mmachine m)
{
  int res;
  char buf[8];
//$$ Try to find in the manual why this value 8

  if (!debug.sock)
    return MERROK;

  // Handle possibly pending break or kill requests
  if (res = DBGHandleBreak(m))
    goto end;
    
  if ((res = recv((SOCKET)debug.sock, buf, 4, MSG_PEEK)) > 0) {
    if (res = DBGSyncRead(m))
	    goto end;
	// Service break or kill requests at once
	  if (res = DBGHandleBreak(m))
	    goto end;
	  return MERROK;
  } else {
    if (res == SOCKET_ERROR) {
	    if ((res = WSAGetLastError()) && res != WSAEWOULDBLOCK)
	      MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGSOCKET"\n", res);
//$$ Ignore socket error?
	    return MERROK;
    } else if (res == 0) {
	    MMechostr(MSKRUNTIME, "(!)"MSGEDEBUGSERVERDOWN"\n");
	    debug.sock = 0;
	    res = MERRDEBUG;
    }
  }

end:
  if (res == MERRDEBUG) {
    MMechostr(MSKRUNTIME, "(!) "MSGEDEBUGCLOSING"\n");
//$$ Should I explicitly close the virtual machine?
    return MERRCLOSE;
  }
  return res;
}
#endif


static int DBGUserTrace(mmachine m)
// [0] function to trace (PB)
{
#if defined(INCLUDE_DEBUGGER)
  if (SEW2I(SEFETCH(m, SEW2P(SEGETTOP(m, 0)), OFFPDBG))) {
    SESETTOP(m, 0, SEI2W(1)); // breakpoint already set!
    return MERROK;
  }
  // Set trace flag of PB
  SESTORE(m, SEW2P(SEGETTOP(m, 0)), OFFPDBG, SEI2W(1));
  // Register breakpoint
  SECHECK(SEDUP(m));
  int res;
  if (res = DBGAddBreakpoint(m, NIL, NIL, NIL))
    return res;
  // Give feedback to user indicating that breakpoint has been set
  SEPTR p = SEW2P(SEGETTOP(m, 0));
  MMechostr(MSKTRACE, "_trace: set breakpoint at function '%s' (%x) %s",
    SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEFETCH(m, p, OFFPVAR)), OFFVNAME))), p,
    SEFETCH(m, p, OFFPLOC) == NIL ? " (hardcoded)\n" : "\n");  
  SESETTOP(m, 0, SEI2W(0));  // okay
  return MERROK;
#else
  SESETTOP(m, 0, NIL);
#endif
  return MERROK;
}


static int DBGDebugSettings(mmachine m)
// [1] debugger URL
// [0] flags (yet not used)
//
// Returns:
//   0: ok
//   1: connection failed
//   2: flags parameter invalid
{
#if defined(INCLUDE_DEBUGGER)
  int res;

  if (SEW2I(SEPOP(m))) {
	  MMechostr(MSKRUNTIME, "_debug: extra flags parameter should be 0\n");
    SESETTOP(m, 0, SEI2W(2));
  } else {
    // Set debugger address to the one specified
	  if (SEGETTOP(m, 0) == NIL) {
      SEWORD addr;
	    // Search first in the resource file */
      if (res = Mpushstrbloc(m, DEBUG_RESSOURCE_FILE_KEY))
	      return res;
      if (res = SCgetress(m))
	      return res;
	    if ((addr = SEPOP(m)) == NIL)
	      strcpy(debug.addr, DEBUG_STANDARD_ADDRESS);
	    else
	      strcpy(debug.addr, SESTR(m, SEW2P(addr)));
    } else
      strcpy(debug.addr, SESTR(m, SEW2P(SEGETTOP(m, 0))));

	  MMechostr(MSKRUNTIME, "_debug: try debugging server address '%s'\n", debug.addr);

    if (DBGOpenChannel(m)) {
      MMechostr(MSKRUNTIME, "_debug: debugging server is unavailable or unreachable\n");
	    debug.sock = 0;          // connection to server failed
	    SESETTOP(m, 0, SEI2W(-1));
    } else
      SESETTOP(m, 0, SEI2W(0));
  }
#else
  SEDROP(m, 1);
  SESETTOP(m, 0, NIL);
#endif
  return MERROK;
}


static int DBGSetChannelName(mmachine m)
// [1] channel
// [0] new name
{
  SESTORE(m, SEW2P(SEGETTOP(m, 1)), OFFCHANUSER, SEGETTOP(m, 0));
#if defined(INCLUDE_DEBUGGER)
  int res;
  if (res = DBGNotifyChannelNameModified(m))
    return res;
#else
  SEDROP(m, 2);
#endif
  return SEPUSH(m, NIL);
}


static int DBGSetMachineName(mmachine m)
// [0] name for this virtual machine
{
  SESETROOT(m, OFFSCNAME, SEGETTOP(m, 0));
  SESETTOP(m, 0, NIL);
  return MERROK;
}


static int DBGBreakNow(mmachine m)
{
  SECHECK(SEPUSH(m, NIL));
#if defined(INCLUDE_DEBUGGER)
  DBGRequestBreak(m, kBrksrcUserBreak);
#endif
  return MERROK;
}


static NativeDefinition defs[] = {
  { "_break",           0,  "fun [] I",            DBGBreakNow       },
  { "_debug",           2,  "fun [S I] I",         DBGDebugSettings  },
  { "_trace",           1,  "fun [fun u0 u1] I",   DBGUserTrace      },
  { "_setchannelname",  2,  "fun [Chn S] I",       DBGSetChannelName },
  { "_setmachinename",  1,  "fun [S] I",           DBGSetMachineName }
};


int SCOLloadDebug(mmachine m)
{
  MMechostr(MSKTRACE, "Loading debugging functions...\n");
  return PKhardpak2(m, DEBUG_PACKAGE_NAME, sizeof(defs)/sizeof(defs[0]), defs);
}