/*
 *	Copyright (c) 1999-2003 Smithsonian Astrophysical Observatory
 */

#include <xpap.h>

#if HAVE_TCL

#include <tcl.h>

/*
 *----------------------------------------------------------------------------
 *
 *
 * 			Private Routines and Data
 *
 *
 *----------------------------------------------------------------------------
 */

/* with Tcl 8.4, some function prototypes have added CONST qualifiers,
   which we try to deal with in a backward-compatible way */
#define XCONST84
#if TCL_MAJOR_VERSION >= 8
#if TCL_MINOR_VERSION >= 4
#undef XCONST84
#define XCONST84 CONST
#endif
#endif

#ifdef NULLSTRING
#undef NULLSTRING
#endif
#define NULLSTRING ""

#define TCL_NULLSTR(s) (!s || !*s || !strcmp(s, "{}"))

#define TY_CLIENT 1
#define TY_SERVER 2

#ifndef MAX_XPAS
#define MAX_XPAS 10000
#endif

/*
 *
 * record struct for client_data for XPATcl[Send,Receive,Info] routines
 *
 */
typedef struct xpatclclientdatarec{
  Tcl_Interp *interp;
  char *callback;
  char *client_data;
} *XPATclClientData, XPATclClientDataRec;


/*
 *----------------------------------------------------------------------------
 *
 * Routine:	Tcl_GetXPAFromObj
 *
 * Purpose:	convert string to XPA handle
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
Tcl_GetXPAFromObj(Tcl_Interp *interp, Tcl_Obj *obj, int flag, XPA *xpa)
#else
static int Tcl_GetXPAFromObj(interp, obj, flag, xpa)
     Tcl_Interp *interp;
     Tcl_Obj *obj;
     int flag;
     XPA *xpa;
#endif
{
  char *s;
  void *lval;
  Tcl_Obj *resultPtr;

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  if( (s = Tcl_GetStringFromObj(obj, NULL)) == NULL ){
    return(TCL_ERROR);
  }
  if( strncmp(s, "xpa_", 4) || (sscanf(&(s[4]), "%p", &lval) != 1) ){
    Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa handle", -1);
    return(TCL_ERROR);
  }
  *xpa = (XPA)lval;
  /* make sure its a valid xpa */
  switch(flag){
  case TY_CLIENT:
    if( !XPAClientValid(*xpa) ){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
    break;
  case TY_SERVER:
    if( !XPAValid(*xpa) ){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa server handle", -1);
      return(TCL_ERROR);
    }
    break;
  }
  return(TCL_OK);
}


/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPATclHandler
 *
 * Purpose:	common handler for access points written in tcl
 * 		execute the tcl receive command with xpa arguments
 *		used instead of Tcl_Eval so we can avoid interpreting either
 *		paramlist or buf
 *
 *
 * Returns:	0 on success, -1 on failure
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int 
XPATclHandler (void *client_data, void *call_data, char *paramlist,
	       char *buf, int len, int nargs)
#else
static int XPATclHandler(client_data, call_data, paramlist, buf, len, nargs)
     void *client_data;
     void *call_data;
     char *paramlist;
     char *buf;
     int len;
     int nargs;
#endif
{
  XPA xpa = (XPA)call_data;
  XPATclClientData xptr = (XPATclClientData)client_data;
  Tcl_CmdInfo info;		/* Info about command procedures */
  Tcl_Obj *objv[10];		/* Object vector for arguments */
  Tcl_Obj *resultPtr;		/* The result object */
  int result;			/* TCL_OK or TCL_ERROR */
  int object;
  char tbuf[SZ_LINE];
  XCONST84 char *argv[10];
  char *s=NULL;
  char *t=NULL;
  char *cmd;

  /* make sure we have a callback */
  if( !xptr || !xptr->callback ){
    XPAError(xpa, "Invalid tcl command for xpa callback");
    return(-1);
  }
  /* set command name */
  cmd = xptr->callback;

  /* Map from the command name to a C procedure */
  if( !Tcl_GetCommandInfo(xptr->interp, cmd, &info) ){
    XPAError(xpa, "Unknown tcl command for xpa callback");
    return(-1);
  }

  /* string-ize some values */
  snprintf(tbuf, SZ_LINE, "xpa_%p", xpa);
  s = xstrdup(tbuf);
  if( nargs > 4 ){
    snprintf(tbuf, SZ_LINE, "%d", len);
    t = xstrdup(tbuf);
  }

  /* package up argument values */
  object = info.isNativeObjectProc;
  if (object) {
    /* The object interface is preferred for this command */
    objv[0] = Tcl_NewStringObj(cmd, strlen(cmd));
    objv[1] = Tcl_NewStringObj(s, strlen(s));
    if( (xptr->client_data == NULL) || (*xptr->client_data == '\0') )
      objv[2] = Tcl_NewStringObj(NULLSTRING, strlen(NULLSTRING));
    else
      objv[2] = Tcl_NewStringObj(xptr->client_data, strlen(xptr->client_data));
    if( (paramlist == NULL) || (*paramlist == '\0') )
      objv[3] = Tcl_NewStringObj(NULLSTRING, strlen(NULLSTRING));
    else
      objv[3] = Tcl_NewStringObj(paramlist, strlen(paramlist));
    if( nargs > 4 ){
      if( (buf == NULL) || (*buf == '\0') || (len == 0) )
	objv[4] = Tcl_NewStringObj(NULLSTRING, strlen(NULLSTRING));
      else
	objv[4] = Tcl_NewStringObj(buf, len);
      objv[5] = Tcl_NewStringObj(t, strlen(t));
    }
  } else {
    argv[0] = cmd;
    argv[1] = s;
    argv[2] = xptr->client_data;
    argv[3] = paramlist;
    if( nargs > 4 ){
      argv[4] = buf;
      argv[5] = t;
    }
  }

  /* reset before we make C call */
  Tcl_ResetResult(xptr->interp);

  /*
   * Invoke the C procedure.
   */
  if (object) {
    result = (*info.objProc)(info.objClientData, xptr->interp, nargs, objv);
    /* Get the string value from the result object */
    resultPtr = Tcl_GetObjResult(xptr->interp);
    Tcl_SetResult(xptr->interp, Tcl_GetStringFromObj(resultPtr, NULL),
		  TCL_VOLATILE);
  } else {
    result = (*info.proc)(info.clientData, xptr->interp, nargs, argv);
  }

  /* clean up */
  if( s ) xfree(s);
  if( t ) xfree(t);

  /* translate Tcl status into XPA status */
  if( result == TCL_OK ){
    return(0);
  }
  else{
    s = (char *)Tcl_GetStringResult(xptr->interp);
    if( !strncmp(s, "XPA$ERROR: ", 11) )
      s += 11;
    XPAError(xpa, s);
    return(-1);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPATclReceive
 *
 * Purpose:	receive handler for access points written in tcl
 * 		execute the tcl receive command with xpa arguments
 *		used instead of Tcl_Eval so we can avoid interpreting either
 *		paramlist or buf
 *
 *
 * Returns:	0 on success, -1 on failure
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int 
XPATclReceive (void *client_data, void *call_data, char *paramlist,
	       char *buf, int len)
#else
static int XPATclReceive(client_data, call_data, paramlist, buf, len)
     void *client_data;
     void *call_data;
     char *paramlist;
     char *buf;
     int len;
#endif
{
  return(XPATclHandler(client_data, call_data, paramlist, buf, len, 6));
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPATclSend
 *
 * Purpose:	send handler for access points written in tcl
 *
 * Returns:	0 on success, -1 on failure
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int 
XPATclSend (void *client_data, void *call_data, char *paramlist,
	    char **buf, int *len)
#else
static int XPATclSend(client_data, call_data, paramlist, buf, len)
     void *client_data;
     void *call_data;
     char *paramlist;
     char **buf;
     int *len;
#endif
{
  return(XPATclHandler(client_data, call_data, paramlist, NULL, 0, 4));
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPATclInfo
 *
 * Purpose:	info handler for access points written in tcl
 *
 * Returns:	0 on success, -1 on failure
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int 
XPATclInfo (void *client_data, void *call_data, char *paramlist)
#else
static int XPATclInfo(client_data, call_data, paramlist)
     void *client_data;
     void *call_data;
     char *paramlist;
#endif
{
  return(XPATclHandler(client_data, call_data, paramlist, NULL, 0, 4));
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPANew_Tcl
 *
 * Purpose:	Tcl binding to XPANew procedure
 *
 * Tcl call:
 *
 *     xpanew class name help sproc sdata smode rproc rdata rmode
 *
 * use the empty string to specify NULL arguments
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPANew_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPANew_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *xclass;
  char *name;
  char *help;
  char *send_cb;
  char *sdata;
  char *smode;
  char *rec_cb;
  char *rdata;
  char *rmode;
  char tbuf[SZ_LINE];
  XPA xpa;
  SendCb sproc;
  ReceiveCb rproc;
  XPATclClientData sptr;
  XPATclClientData rptr;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 10 ){
    Tcl_WrongNumArgs(interp, 1, objv, 
     "class name help sproc sdata smode rproc rdata rmode");
    return(TCL_ERROR);
  }

  /* get arguments as strings */
  xclass = Tcl_GetStringFromObj(objv[1], NULL);
  name = Tcl_GetStringFromObj(objv[2], NULL);
  help = Tcl_GetStringFromObj(objv[3], NULL);
  send_cb = Tcl_GetStringFromObj(objv[4], NULL);
  sdata = Tcl_GetStringFromObj(objv[5], NULL);
  smode = Tcl_GetStringFromObj(objv[6], NULL);
  rec_cb = Tcl_GetStringFromObj(objv[7], NULL);
  rdata = Tcl_GetStringFromObj(objv[8], NULL);
  rmode = Tcl_GetStringFromObj(objv[9], NULL);

  /* this will hold the result */
  resultPtr = Tcl_GetObjResult(interp);

  /* set up callback procedures */
  if( ((send_cb == NULL) || (*send_cb == '\0') ) ){
    sproc = NULL;
    sptr = NULL;
  }
  else{
    sproc = XPATclSend;
    sptr = (XPATclClientData)xcalloc(1, sizeof(XPATclClientDataRec));
    sptr->interp = interp;
    sptr->callback = xstrdup(send_cb);
    sptr->client_data = xstrdup(sdata);
  }
  if( ((rec_cb == NULL) || (*rec_cb == '\0') ) ){
    rproc = NULL;
    rptr = NULL;
  }
  else{
    rproc = XPATclReceive;
    rptr = (XPATclClientData)xcalloc(1, sizeof(XPATclClientDataRec));
    rptr->interp = interp;
    rptr->callback = xstrdup(rec_cb);
    rptr->client_data = xstrdup(rdata);
  }

  /* make sure we have either a send or receive callback */
  if( !sproc && !rproc ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: xpanew requires send_cb or rec_cb (or both)", -1);
    return(TCL_ERROR);
  }

  /* set up the tcl handler for the xpa access point */
  xpa = XPANew(xclass, name, help, sproc, sptr, smode, rproc, rptr, rmode);
  if( xpa == NULL ){
    Tcl_SetStringObj(resultPtr,
		     "XPA$ERROR: could not create XPA access point", -1);
    return(TCL_ERROR);
  }
  else{
    /* add this xpa to the Tcl event loop */
    XPATclAddInput(xpa);
    /* return xpa address to tcl in a string */
    snprintf(tbuf, SZ_LINE, "xpa_%p", xpa);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_OK);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAFree_Tcl
 *
 * Purpose:	Tcl binding to XPAFree procedure
 *
 * Tcl call:
 *
 *     xpafree xpa
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAFree_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAFree_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  XPATclClientData ptr;

  /* make sure argument count is correct */
  if( objc != 2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* free the associated tcl record, stored in the client data */
  if( xpa->send_data ){
    ptr = (XPATclClientData)xpa->send_data;
    if( ptr->callback )    xfree( ptr->callback);
    if( ptr->client_data ) xfree( ptr->client_data);
    xfree(xpa->send_data);
  }
  if( xpa->receive_data ){
    ptr = (XPATclClientData)xpa->receive_data;
    if( ptr->callback )    xfree( ptr->callback);
    if( ptr->client_data ) xfree( ptr->client_data);
    xfree(xpa->receive_data);
  }
  if( xpa->info_data ){ 
    ptr = (XPATclClientData)xpa->info_data;
    if( ptr->callback )    xfree( ptr->callback);
    if( ptr->client_data ) xfree( ptr->client_data);
    xfree(xpa->info_data);
  }

  /* call the XPAFree routine */
  XPAFree(xpa);
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAInfoNew_Tcl
 *
 * Purpose:	Tcl binding to XPAInfoNew procedure
 *
 * Tcl call:
 *
 *     xpanew class name help iproc idata imode
 *
 * use the empty string to specify NULL arguments
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAInfoNew_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAInfoNew_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *xclass;
  char *name;
  char *info_cb;
  char *idata;
  char *imode;
  char tbuf[SZ_LINE];
  XPA xpa;
  InfoCb iproc;
  XPATclClientData iptr;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 6 ){
    Tcl_WrongNumArgs(interp, 1, objv, 
     "class name iproc idata imode");
    return(TCL_ERROR);
  }

  /* get arguments as strings */
  xclass = Tcl_GetStringFromObj(objv[1], NULL);
  name = Tcl_GetStringFromObj(objv[2], NULL);
  info_cb = Tcl_GetStringFromObj(objv[3], NULL);
  idata = Tcl_GetStringFromObj(objv[4], NULL);
  imode = Tcl_GetStringFromObj(objv[5], NULL);

  /* this will hold the result */
  resultPtr = Tcl_GetObjResult(interp);

  /* set up callback procedures */
  if( info_cb == NULL ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: xpainfonew requires info_cb", -1);
    return(TCL_ERROR);
  }
  else{
    iproc = XPATclInfo;
    iptr = (XPATclClientData)xcalloc(1, sizeof(XPATclClientDataRec));
    iptr->interp = interp;
    iptr->callback = xstrdup(info_cb);
    iptr->client_data = xstrdup(idata);
  }

  /* set up the tcl handler for the xpa access point */
  xpa = XPAInfoNew(xclass, name, iproc, iptr, imode);
  if( xpa == NULL ){
    Tcl_SetStringObj(resultPtr,
		     "XPA$ERROR: could not create XPA info access point", -1);
    return(TCL_ERROR);
  }
  else{
    /* add this xpa to the Tcl event loop */
    XPATclAddInput(xpa);
    /* return xpa address to tcl in a string */
    snprintf(tbuf, SZ_LINE, "xpa_%p", xpa);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_OK);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPACmdNew_Tcl
 *
 * Purpose:	Tcl binding to XPACmdNew procedure
 *
 * Tcl call:
 *
 *     xpacmdnew class name
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPACmdNew_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPACmdNew_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *xclass;
  char *name;
  char tbuf[SZ_LINE];
  XPA xpa;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "class name");
    return(TCL_ERROR);
  }

  /* get arguments as strings */
  xclass = Tcl_GetStringFromObj(objv[1], NULL);
  name = Tcl_GetStringFromObj(objv[2], NULL);

  /* this will hold the result */
  resultPtr = Tcl_GetObjResult(interp);

  /* set up the tcl handler for the xpa access point */
  if( (xpa = XPACmdNew(xclass, name)) == NULL ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: could not create XPA command access point", -1);
    return(TCL_ERROR);
  }
  else{
    /* add this xpa to the Tcl event loop */
    XPATclAddInput(xpa);
    /* return xpa address to tcl in a string */
    snprintf(tbuf, SZ_LINE, "xpa_%p", xpa);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_OK);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPACmdAdd_Tcl
 *
 * Purpose:	Tcl binding to XPACmdAdd procedure
 *
 * Tcl call:
 *
 *     xpacmdadd xpa name help sproc sdata smode rproc rdata rmode
 *
 * use the empty string to specify NULL arguments
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPACmdAdd_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPACmdAdd_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *name;
  char *help;
  char *send_cb;
  char *sdata;
  char *smode;
  char *rec_cb;
  char *rdata;
  char *rmode;
  char tbuf[SZ_LINE];
  XPA xpa;
  XPACmd xpacmd;
  SendCb sproc;
  ReceiveCb rproc;
  XPATclClientData sptr;
  XPATclClientData rptr;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 10 ){
    Tcl_WrongNumArgs(interp, 1, objv, 
     "class name help sproc sdata smode rproc rdata rmode");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1],  TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  name = Tcl_GetStringFromObj(objv[2], NULL);
  help = Tcl_GetStringFromObj(objv[3], NULL);
  send_cb = Tcl_GetStringFromObj(objv[4], NULL);
  sdata = Tcl_GetStringFromObj(objv[5], NULL);
  smode = Tcl_GetStringFromObj(objv[6], NULL);
  rec_cb = Tcl_GetStringFromObj(objv[7], NULL);
  rdata = Tcl_GetStringFromObj(objv[8], NULL);
  rmode = Tcl_GetStringFromObj(objv[9], NULL);

  /* this will hold the result */
  resultPtr = Tcl_GetObjResult(interp);

  /* set up callback procedures */
  if( ((send_cb == NULL) || (*send_cb == '\0') ) ){
    sproc = NULL;
    sptr = NULL;
  }
  else{
    sproc = XPATclSend;
    sptr = (XPATclClientData)xcalloc(1, sizeof(XPATclClientDataRec));
    sptr->interp = interp;
    sptr->callback = xstrdup(send_cb);
    sptr->client_data = xstrdup(sdata);
  }
  if( ((rec_cb == NULL) || (*rec_cb == '\0') ) ){
    rproc = NULL;
    rptr = NULL;
  }
  else{
    rproc = XPATclReceive;
    rptr = (XPATclClientData)xcalloc(1, sizeof(XPATclClientDataRec));
    rptr->interp = interp;
    rptr->callback = xstrdup(rec_cb);
    rptr->client_data = xstrdup(rdata);
  }

  /* make sure we have either a send or receive callback */
  if( !sproc && !rproc ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: xpacmdadd requires send_cb or rec_cb (or both)", -1);
    return(TCL_ERROR);
  }

  /* set up the tcl handler for the xpa access point */
  xpacmd = XPACmdAdd(xpa, name, help, sproc, sptr, smode, rproc, rptr, rmode);
  if( xpacmd == NULL ){
    Tcl_SetStringObj(resultPtr, "XPA$ERROR: could not create XPA command", -1);
    return(TCL_ERROR);
  }
  else{
    /* return xpa address to tcl in a string */
    snprintf(tbuf, SZ_LINE, "xpacmd_%p", xpacmd);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_OK);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPACmdDel_Tcl
 *
 * Purpose:	Tcl binding to XPACmdDel procedure
 *
 * Tcl call:
 *
 *     xpacmddel xpa cmd
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPACmdDel_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPACmdDel_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  void *lval;
  char *s;
  XPA xpa;
  XPACmd cmd;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa cmd");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* get xpacmd, which is always arg 2 */
  if( (s = Tcl_GetStringFromObj(objv[2], NULL)) == NULL ){
    return(TCL_ERROR);
  }
  if( strncmp(s, "xpacmd_", 7) || (sscanf(&(s[7]), "%p", &lval) != 1) ){
    Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpacmd handle", -1);
    return(TCL_ERROR);
  }
  cmd = (XPACmd)lval;

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* call the XPACmdDel routine */
  if( XPACmdDel(xpa, cmd) == 0 ){
    /* free the associated tcl record, stored in the client data */
    if( cmd->send_data )    xfree(cmd->send_data);
    if( cmd->receive_data ) xfree(cmd->receive_data);
    return(TCL_OK);
  }
  else{
    resultPtr = Tcl_GetObjResult(interp);
    Tcl_SetStringObj(resultPtr, "XPA$ERROR: could not delete xpa cmd", -1);
    return(TCL_ERROR);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPARec_Tcl
 *
 * Purpose:	Tcl binding to retrieve info from the xpa struct
 *
 * Tcl call:
 *
 *     set val [xparec xpa <option>]
 *
 *     where option can be one of the following:
 *
 *			name
 *			class
 *			method
 *			cmdfd
 *			datafd
#ifndef HAVE_CYGWIN
 *			cmdchan
 *			datachan
#endif
 *			sendian
 *			cendian
 *			version
 *		
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPARec_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPARec_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
#ifndef HAVE_CYGWIN
  Tcl_Channel chan;
#endif
  static XCONST84 char *subCmds[] = {
    "cendian",
    "class",
#ifndef HAVE_CYGWIN
    "cmdchan",
#endif
    "cmdfd",
#ifndef HAVE_CYGWIN
    "datachan",
#endif
    "datafd",
    "method",
    "name",
    "sendian",
    "version",
    (char *) NULL};
  enum ISubCmdIdx {
    ICendianIdx,
    IClassIdx,
#ifndef HAVE_CYGWIN
    ICmdChanIdx,
#endif
    ICmdFdIdx,
#ifndef HAVE_CYGWIN
    IDataChanIdx,
#endif
    IDataFdIdx,
    IMethodIdx,
    INameIdx,
    ISendianIdx,
    IVersionIdx
  } index;
  XPA xpa;
  int result;
  char tbuf[SZ_LINE];

  /* we always have 3 args: xparec $xpa [option] */
  if (objc != 3) {
    Tcl_WrongNumArgs(interp, 1, objv, "xpa option");
    return TCL_ERROR;
  }

  /* get sub-command index */
  if( (result = Tcl_GetIndexFromObj(interp, objv[2], subCmds, "option", 0,
				    (int *)&index)) != TCL_OK ){
    return result;
  }

  /* get xpa, which is always arg 1 */
  if( (result=Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa)) != TCL_OK){
    /* valid xpa is required, except for version */
    if( index != IVersionIdx )
      return(TCL_ERROR);
  }

  /* process sub-command */
  switch (index) {
  case ICendianIdx:
    Tcl_SetResult(interp, (char *)xpa_cendian(xpa), TCL_VOLATILE);
    result = TCL_OK;
    break;
  case IClassIdx:
    Tcl_SetResult(interp, xpa_class(xpa), TCL_VOLATILE);
    result = TCL_OK;
    break;
#ifndef HAVE_CYGWIN
  case ICmdChanIdx:
    snprintf(tbuf, SZ_LINE, "sock%d", xpa_cmdfd(xpa));
    /* make sure we have a valid OS socket fd */
    if( xpa_cmdfd(xpa) < 0 ){
      Tcl_SetResult(interp, "none", TCL_STATIC);
      result = TCL_OK;
    }
    /* see if this socket already is defined as a tcl variable */
    else if( Tcl_GetChannel(interp, tbuf, NULL) != NULL ){
      Tcl_SetResult(interp, tbuf, TCL_VOLATILE);
      result = TCL_OK;
    }
    /* create new tcl variable for this socket */
    else{
      /* create a tcl channel corresponding to the xpa socket */
      if( !(chan = Tcl_MakeTcpClientChannel((ClientData)xpa_cmdfd(xpa))) ){
	Tcl_SetResult(interp, "XPA$ERROR: could not map XPA cmdfd to tcl",
		      TCL_STATIC);
	result = TCL_ERROR;
      }
      else{
	/* hold a reference to this channel outside tcl */
	Tcl_RegisterChannel(NULL, chan);
	/* register this channel with tcl */
	Tcl_RegisterChannel(interp, chan);
	/* make this Tcl channel unbuffered, so user does not have to flush */
	Tcl_SetChannelOption(interp, chan, "-buffering", "none");
	/* return name so that it can be used by tcl */
	Tcl_SetResult(interp, (char *)Tcl_GetChannelName(chan), TCL_VOLATILE);
	result = TCL_OK;
      }
    }
    break;
#endif
  case ICmdFdIdx:
    if( xpa_cmdfd(xpa) < 0 )
      strcpy(tbuf, "none");
    else
      snprintf(tbuf, SZ_LINE, "%d", xpa_cmdfd(xpa));
    Tcl_SetResult(interp, tbuf, TCL_VOLATILE);
    result = TCL_OK;
    break;
#ifndef HAVE_CYGWIN
  case IDataChanIdx:
    snprintf(tbuf, SZ_LINE, "sock%d", xpa_datafd(xpa));
    /* make sure we have a valid OS socket fd */
    if( xpa_datafd(xpa) < 0 ){
      Tcl_SetResult(interp, "none", TCL_STATIC);
      result = TCL_OK;
    }
    /* see if this socket already is defined as a tcl variable */
    else if( Tcl_GetChannel(interp, tbuf, NULL) != NULL ){
      Tcl_SetResult(interp, tbuf, TCL_VOLATILE);
      result = TCL_OK;
    }
    /* create new tcl variable for this socket */
    else{
      if( !(chan = Tcl_MakeTcpClientChannel((ClientData)xpa_datafd(xpa))) ){
	Tcl_SetResult(interp, "XPA$ERROR: could not map XPA datafd to tcl",
		      TCL_STATIC);
	result = TCL_ERROR;
      }
      else{
	/* hold a reference to this channel outside tcl */
	Tcl_RegisterChannel(NULL, chan);
	/* register this channel with tcl */
	Tcl_RegisterChannel(interp, chan);
	/* make this Tcl channel unbuffered, so user does not have to flush */
	Tcl_SetChannelOption(interp, chan, "-buffering", "none");
	/* return name so that it can be used by tcl */
	Tcl_SetResult(interp, (char *)Tcl_GetChannelName(chan), TCL_VOLATILE);
	result = TCL_OK;
      }
    }
    break;
#endif
  case IDataFdIdx:
    if( xpa_datafd(xpa) < 0 )
      strcpy(tbuf, "none");
    else
      snprintf(tbuf, SZ_LINE, "%d", xpa_datafd(xpa));
    Tcl_SetResult(interp, tbuf, TCL_VOLATILE);
    result = TCL_OK;
    break;
  case IMethodIdx:
    Tcl_SetResult(interp, xpa_method(xpa), TCL_VOLATILE);
    result = TCL_OK;
    break;
  case INameIdx:
    Tcl_SetResult(interp, xpa_name(xpa), TCL_VOLATILE);
    result = TCL_OK;
    break;
  case ISendianIdx:
    Tcl_SetResult(interp, xpa_sendian(xpa), TCL_VOLATILE);
    result = TCL_OK;
    break;
  case IVersionIdx:
    snprintf(tbuf, SZ_LINE, "%s", XPA_VERSION);
    Tcl_SetResult(interp, tbuf, TCL_VOLATILE);
    result = TCL_OK;
    break;
  }
  return result;
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPASetBuf_Tcl
 *
 * Purpose:	Tcl binding to XPASetBuf procedure
 *
 * Tcl call:
 *
 *     xpasetbuf xpa buf len
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPASetBuf_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPASetBuf_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  int len;
  int error;
  char *buf;
  XPA xpa;

  /* make sure argument count is correct */
  if( objc < 3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa buf len");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* get buf */
  buf = Tcl_GetStringFromObj(objv[2], &len);
  /* get len if specified */
  if( objc >= 4 ){
    if( (error = Tcl_GetIntFromObj(interp, objv[3], &len)) != TCL_OK )
      return(error);
  }
  /* copy buffer to the xpa struct */
  XPASetBuf(xpa, buf, len, 1);
  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAOpen_Tcl
 *
 * Purpose:	Tcl binding to XPAOpen procedure
 *
 * Tcl call:
 *
 *     xpaopen mode
 *
 * mode currently is NULL
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAOpen_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAOpen_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *mode;
  char tbuf[SZ_LINE];
  XPA xpa;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( objc != 2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "mode");
    return(TCL_ERROR);
  }

  /* get arguments as strings */
  mode = Tcl_GetStringFromObj(objv[1], NULL);

  /* this will hold the result */
  resultPtr = Tcl_GetObjResult(interp);

  /* set up the tcl handler for the xpa access point */
  xpa = XPAOpen(mode);
  if( xpa == NULL ){
    Tcl_SetStringObj(resultPtr,
		     "XPA$ERROR: could not open XPA", -1);
    return(TCL_ERROR);
  }
  else{
    /* return xpa address to tcl in a string */
    snprintf(tbuf, SZ_LINE, "xpa_%p", xpa);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_OK);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAClose_Tcl
 *
 * Purpose:	Tcl binding to XPAClose procedure
 *
 * Tcl call:
 *
 *     xpaclose xpa
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAClose_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAClose_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;

  /* make sure argument count is correct */
  if( objc != 2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* call the XPAClose routine */
  XPAClose(xpa);
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAGet_Tcl
 *
 * Purpose:	Tcl binding to XPAGet procedure
 *
 * Tcl call:
 *
 *     set got [xpaget xpa template paramlist mode bufs lens names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAGet_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAGet_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  int *clens=NULL;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  /* char *bufs; */
  /* char *lens; */
  char *names;
  char *errs;
  char **cbufs=NULL;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *bufsPtr;
  Tcl_Obj *lensPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **bufsObjv;
  Tcl_Obj **lensObjv;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;

  /* make sure argument count is correct */
  if( objc != 10 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode bufs lens names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  /* bufs = Tcl_GetStringFromObj(objv[5], NULL); */
  /* lens = Tcl_GetStringFromObj(objv[6], NULL); */
  names = Tcl_GetStringFromObj(objv[7], NULL);
  errs = Tcl_GetStringFromObj(objv[8], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[9], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  /* allocate return buffers */
  cbufs  = (char **)xcalloc(n, sizeof(char *));
  bufsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  clens  =   (int *)xcalloc(n, sizeof(int));
  lensObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPAGet(xpa, tmpl, paramlist, mode, cbufs, clens, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      bufsObjv[i] = Tcl_NewObj();
      Tcl_SetStringObj(bufsObjv[i], cbufs[i], clens[i]);
      
      lensObjv[i] = Tcl_NewObj();
      Tcl_SetIntObj(lensObjv[i], clens[i]);
      
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }
      
      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    bufsPtr = Tcl_NewObj();
    Tcl_SetListObj(bufsPtr, got, bufsObjv);
    Tcl_ObjSetVar2(interp, objv[5], NULL, bufsPtr, TCL_PARSE_PART1);
    
    lensPtr = Tcl_NewObj();
    Tcl_SetListObj(lensPtr, got, lensObjv);
    Tcl_ObjSetVar2(interp, objv[6], NULL, lensPtr, TCL_PARSE_PART1);
    
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[7], NULL, namesPtr, TCL_PARSE_PART1);
    }
    
    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[8], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    Tcl_ObjSetVar2(interp, objv[5], NULL, nullPtr, TCL_PARSE_PART1);
    Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[7], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[8], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cbufs[i]  ) xfree((char *)cbufs[i]);
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cbufs  )    xfree((char *)cbufs);
  if( clens  )    xfree((char *)clens);
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( bufsObjv )  xfree((char *)bufsObjv);
  if( lensObjv )  xfree((char *)lensObjv);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  resultPtr = Tcl_GetObjResult(interp);
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAGetFd_Tcl
 *
 * Purpose:	Tcl binding to XPAGetFd procedure
 *
 * Tcl call:
 *
 *     set got [xpaget xpa template paramlist mode chans names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAGetFd_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAGetFd_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  int flag;
  int *cfds;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  char *names;
  char *errs;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *fdPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;
  Tcl_Channel chan;

  /* make sure argument count is correct */
  if( objc != 9 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode chans names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK ){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  names = Tcl_GetStringFromObj(objv[6], NULL);
  errs = Tcl_GetStringFromObj(objv[7], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[8], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  /* get file descriptors */
  if( n < 0 ){
    cfds  = (int *)xcalloc(1, sizeof(int));
    if( Tcl_ListObjIndex(interp, objv[5], 0, &fdPtr) != TCL_OK ){
      Tcl_SetStringObj(resultPtr, 
	       "XPA$ERROR: invalid channel list passed to xpagetfd", -1);
      return(TCL_ERROR);
    }
    else{
      chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(fdPtr, NULL),
			    &flag);
      if( chan == NULL ){
	Tcl_SetStringObj(resultPtr, 
		 "XPA$ERROR: invalid channel passed to xpagetfd", -1);
	return(TCL_ERROR);
      }
      if( !(flag&TCL_WRITABLE) ){
	Tcl_SetStringObj(resultPtr, 
		 "XPA$ERROR: non-writable channel passed to xpagetfd", -1);
	return(TCL_ERROR);
      }
      Tcl_GetChannelHandle(chan, TCL_WRITABLE, (ClientData *)&(cfds[0]));
    }
  }
  else{
    cfds  = (int *)xcalloc(n, sizeof(int));
    for(i=0; i<n; i++){
      if( Tcl_ListObjIndex(interp, objv[5], i, &fdPtr) != TCL_OK ){
	Tcl_SetStringObj(resultPtr, 
		 "XPA$ERROR: invalid channel list passed to xpagetfd", -1);
	return(TCL_ERROR);
      }
      else{
	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(fdPtr, NULL),
			      &flag);
	if( chan == NULL ){
	  Tcl_SetStringObj(resultPtr, 
		 "XPA$ERROR: invalid channel passed to xpagetfd", -1);
	  return(TCL_ERROR);
	}
	if( !(flag&TCL_WRITABLE) ){
	  Tcl_SetStringObj(resultPtr, 
		 "XPA$ERROR: non-writable channel passed to xpagetfd", -1);
	  return(TCL_ERROR);
	}
	Tcl_GetChannelHandle(chan, TCL_WRITABLE, (ClientData *)&(cfds[i]));
      }
    }
  }

  /* allocate return buffers */
  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPAGetFd(xpa, tmpl, paramlist, mode, cfds, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }

      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[6], NULL, namesPtr, TCL_PARSE_PART1);
    }
    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[7], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[7], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cfds   )    xfree((char *)cfds);
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPASet_Tcl
 *
 * Purpose:	Tcl binding to XPASet procedure
 *
 * Tcl call:
 *
 *     set got [xpaset xpa template paramlist mode buf len names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPASet_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPASet_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  int len;
  int blen;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  char *buf;
  char *names;
  char *errs;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;

  /* make sure argument count is correct */
  if( objc != 10 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode buf len names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK ){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  buf = Tcl_GetStringFromObj(objv[5], &blen);
  if( (Tcl_GetIntFromObj(interp, objv[6], &len) != TCL_OK) || (len < 0) ){
    len = blen;
  }
  names = Tcl_GetStringFromObj(objv[7], NULL);
  errs = Tcl_GetStringFromObj(objv[8], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[9], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  /* allocate return buffers */
  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPASet(xpa, tmpl, paramlist, mode, buf, len, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }
      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[7], NULL, namesPtr, TCL_PARSE_PART1);
    }
    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[8], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[7], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[8], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPASetFd_Tcl
 *
 * Purpose:	Tcl binding to XPASetFd procedure
 *
 * Tcl call:
 *
 *     set got [xpasetfd xpa template paramlist mode chan names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPASetFd_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPASetFd_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  int flag;
  int fd;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  char *names;
  char *errs;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;
  Tcl_Channel chan;

  /* make sure argument count is correct */
  if( objc != 9 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode chan names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  names = Tcl_GetStringFromObj(objv[6], NULL);
  errs = Tcl_GetStringFromObj(objv[7], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[8], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  /* allocate return buffers */
  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* get file descriptor */
  chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[5], NULL), &flag);
  if( chan == NULL ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: invalid channel passed to xpasetfd", -1);
    return(TCL_ERROR);
  }
  if( !(flag&TCL_READABLE) ){
    Tcl_SetStringObj(resultPtr, 
       "XPA$ERROR: non-readable channel passed to xpasetfd", -1);
    return(TCL_ERROR);
  }
  Tcl_GetChannelHandle(chan, TCL_READABLE, (ClientData *)&fd);

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPASetFd(xpa, tmpl, paramlist, mode, fd, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }
      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[6], NULL, namesPtr, TCL_PARSE_PART1);
    }
    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[7], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[7], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAInfo_Tcl
 *
 * Purpose:	Tcl binding to XPAInfo procedure
 *
 * Tcl call:
 *
 *     set got [xpainfo xpa template paramlist mode names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAInfo_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAInfo_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  char *names;
  char *errs;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;

  /* make sure argument count is correct */
  if( objc != 8 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  names = Tcl_GetStringFromObj(objv[5], NULL);
  errs = Tcl_GetStringFromObj(objv[6], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[7], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  /* allocate return buffers */
  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPAInfo(xpa, tmpl, paramlist, mode, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }
      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[5], NULL, namesPtr, TCL_PARSE_PART1);
    }

    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[6], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[5], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAAccess_Tcl
 *
 * Purpose:	Tcl binding to XPAAccess procedure
 *
 * Tcl call:
 *
 *     set got [xpaaccess xpa template paramlist mode names errs n]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAAccess_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAAccess_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int got;
  int n;
  int i;
  char *xpastr;
  char *tmpl;
  char *paramlist;
  char *mode;
  char *names;
  char *errs;
  char **cnames=NULL;
  char **cerrs=NULL;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *errsPtr;
  Tcl_Obj **namesObjv=NULL;
  Tcl_Obj **errsObjv=NULL;

  /* make sure argument count is correct */
  if( objc != 8 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "xpa template paramlist mode names errs n");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[2], NULL);
  paramlist = Tcl_GetStringFromObj(objv[3], NULL);
  mode = Tcl_GetStringFromObj(objv[4], NULL);
  names = Tcl_GetStringFromObj(objv[5], NULL);
  errs = Tcl_GetStringFromObj(objv[6], NULL);
  if( (Tcl_GetIntFromObj(interp, objv[7], &n) != TCL_OK) || (n < 1) ){
    n = 1;
  }

  if( !TCL_NULLSTR(names) ){
    cnames = (char **)xcalloc(n, sizeof(char *));
    namesObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }
  if( !TCL_NULLSTR(errs) ){
    cerrs  = (char **)xcalloc(n, sizeof(char *));
    errsObjv = (Tcl_Obj **)xcalloc(n, sizeof(Tcl_Obj *));
  }

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* make the XPA C call */
  got = XPAAccess(xpa, tmpl, paramlist, mode, cnames, cerrs, n);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      if( cnames ){
	namesObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(namesObjv[i], cnames[i],
			 cnames[i] ? strlen(cnames[i]) : 0);
      }
      if( cerrs ){
	errsObjv[i] = Tcl_NewObj();
	Tcl_SetStringObj(errsObjv[i], cerrs[i], 
			 cerrs[i] ? strlen(cerrs[i]) : 0);
      }
    }
    /* make lists from the return arguments and set the return variables */
    if( cnames ){
      namesPtr = Tcl_NewObj();
      Tcl_SetListObj(namesPtr, got, namesObjv);
      Tcl_ObjSetVar2(interp, objv[5], NULL, namesPtr, TCL_PARSE_PART1);
    }
    if( cerrs ){
      errsPtr = Tcl_NewObj();
      Tcl_SetListObj(errsPtr, got, errsObjv);
      Tcl_ObjSetVar2(interp, objv[6], NULL, errsPtr, TCL_PARSE_PART1);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    if( cnames )
      Tcl_ObjSetVar2(interp, objv[5], NULL, nullPtr, TCL_PARSE_PART1);
    if( cerrs )
      Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* free up space */
  for(i=0; i<got; i++){
    if( cnames[i] ) xfree((char *)cnames[i]);
    if( cerrs[i]  ) xfree((char *)cerrs[i]);
  }
  if( cnames )    xfree((char *)cnames);
  if( cerrs  )    xfree((char *)cerrs);
  if( namesObjv ) xfree((char *)namesObjv);
  if( errsObjv  ) xfree((char *)errsObjv);

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPANSLookup_Tcl
 *
 * Purpose:	Tcl binding to XPANSLookup procedure
 *
 * Tcl call:
 *
 *     set got [xpanslookup template type]
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPANSLookup_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPANSLookup_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int i;
  int got;
  char *xpastr;
  char *tmpl;
  char *ttype;
  char **xclasses;
  char **names;
  char **methods;
  char **infos;
  Tcl_Obj *resultPtr;
  Tcl_Obj *nullPtr;
  Tcl_Obj *classesPtr;
  Tcl_Obj *namesPtr;
  Tcl_Obj *methodsPtr;
  Tcl_Obj *infosPtr;
  Tcl_Obj **classesObjv;
  Tcl_Obj **namesObjv;
  Tcl_Obj **methodsObjv;
  Tcl_Obj **infosObjv;

  /* make sure argument count is correct */
  if( objc != 7 ){
    Tcl_WrongNumArgs(interp, 1, objv,
		     "template type classes names methods infos");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get other args */
  tmpl = Tcl_GetStringFromObj(objv[1], NULL);
  ttype = Tcl_GetStringFromObj(objv[2], NULL);

  /* reset before we make C call */
  Tcl_ResetResult(interp);

  /* get xpa struct pointer, which might be NULL */
  xpastr = Tcl_GetStringFromObj(objv[1], NULL);
  if( TCL_NULLSTR(xpastr) )
    xpa = NULL;
  else{
    /* get xpa, which is always arg 1 */
    if( Tcl_GetXPAFromObj(interp, objv[1], TY_CLIENT, &xpa) != TCL_OK){
      Tcl_SetStringObj(resultPtr, "XPA$ERROR: invalid xpa client handle", -1);
      return(TCL_ERROR);
    }
  }

  /* make the XPA C call */
  got = XPANSLookup(xpa, tmpl, ttype, &xclasses, &names, &methods, &infos);

  /* if we got anything, fill in the blanks */
  if( got > 0 ){
    /* allocate just enough pointers */
    classesObjv = (Tcl_Obj **)xcalloc(got, sizeof(Tcl_Obj *));
    namesObjv = (Tcl_Obj **)xcalloc(got, sizeof(Tcl_Obj *));
    methodsObjv = (Tcl_Obj **)xcalloc(got, sizeof(Tcl_Obj *));
    infosObjv = (Tcl_Obj **)xcalloc(got, sizeof(Tcl_Obj *));

    /* generate a Tcl object for each return argument */
    for(i=0; i<got; i++){
      classesObjv[i] = Tcl_NewObj();
      Tcl_SetStringObj(classesObjv[i], xclasses[i], strlen(xclasses[i]));
      namesObjv[i] = Tcl_NewObj();
      Tcl_SetStringObj(namesObjv[i], names[i], strlen(names[i]));
      methodsObjv[i] = Tcl_NewObj();
      Tcl_SetStringObj(methodsObjv[i], methods[i], strlen(methods[i]));
      infosObjv[i] = Tcl_NewObj();
      Tcl_SetStringObj(infosObjv[i], infos[i], strlen(infos[i]));
    }
    /* make lists from the return arguments and set the return variables */
    classesPtr = Tcl_NewObj();
    Tcl_SetListObj(classesPtr, got, classesObjv);
    Tcl_ObjSetVar2(interp, objv[3], NULL, classesPtr, TCL_PARSE_PART1);

    namesPtr = Tcl_NewObj();
    Tcl_SetListObj(namesPtr, got, namesObjv);
    Tcl_ObjSetVar2(interp, objv[4], NULL, namesPtr, TCL_PARSE_PART1);
    
    methodsPtr = Tcl_NewObj();
    Tcl_SetListObj(methodsPtr, got, methodsObjv);
    Tcl_ObjSetVar2(interp, objv[5], NULL, methodsPtr, TCL_PARSE_PART1);
    
    infosPtr = Tcl_NewObj();
    Tcl_SetListObj(infosPtr, got, infosObjv);
    Tcl_ObjSetVar2(interp, objv[5], NULL, infosPtr, TCL_PARSE_PART1);
    
    /* free up the space */
    for(i=0; i<got; i++){
      /* done with these strings */
      xfree(xclasses[i]);
      xfree(names[i]);
      xfree(methods[i]);
      xfree(infos[i]);
    }
    /* free up arrays alloc'ed by name server */
    if( got > 0 ){
      xfree(xclasses);
      xfree(names);
      xfree(methods);
      xfree(infos);
      xfree(classesObjv);
      xfree(namesObjv);
      xfree(methodsObjv);
      xfree(infosObjv);
    }
  }
  else{
    nullPtr = Tcl_NewObj();
    Tcl_SetStringObj(nullPtr, "", -1);
    Tcl_ObjSetVar2(interp, objv[3], NULL, nullPtr, TCL_PARSE_PART1);
    Tcl_ObjSetVar2(interp, objv[4], NULL, nullPtr, TCL_PARSE_PART1);
    Tcl_ObjSetVar2(interp, objv[5], NULL, nullPtr, TCL_PARSE_PART1);
    Tcl_ObjSetVar2(interp, objv[6], NULL, nullPtr, TCL_PARSE_PART1);
  }

  /* return the number of accesses as the tcl function result */
  Tcl_SetIntObj(resultPtr, got);

  /* return status */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPANSKeepAlive_Tcl
 *
 * Purpose:	Tcl binding to XPANSKeepAlive procedure
 *
 * Tcl call:
 *
 *     xpafree xpa
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPANSKeepAlive_Tcl(ClientData clientData, Tcl_Interp *interp,
		   int objc, Tcl_Obj *CONST objv[])
#else
static int XPANSKeepAlive_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  XPA xpa;
  int type=0;
  char *s=NULL;

  /* make sure argument count is correct */
  if( objc < 2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa [type]");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* optional type, usually not specified for default */
  if( (objc >= 3) && (s = Tcl_GetStringFromObj(objv[2], NULL)) != NULL )
    type = atoi(s);

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* call the XPANSKeepAlive routine */
  XPANSKeepAlive(xpa, type);

  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPARemote_Tcl
 *
 * Purpose:	Tcl binding to XPARemote procedure
 *
 * Tcl call:
 *
 *     xpaRemote xpa host acl
 *
 * use the empty string to specify NULL arguments
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPARemote_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPARemote_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  int got;
  char *host;
  char *acl="+";
  char *s;
  char *mode=NULL;
  char tbuf[SZ_LINE];
  XPA xpa;
  Tcl_Obj *resultPtr;

  /* make sure argument count is correct */
  if( (objc < 3) || (objc > 5) ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa host [acl] [-proxy]");
    return(TCL_ERROR);
  }

  /* get result pointer */
  resultPtr = Tcl_GetObjResult(interp);

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1],  TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* make sure we are using inet sockets */
  if( XPAMtype() != XPA_INET ){
    snprintf(tbuf, SZ_LINE, "remote requires that XPA_METHOD be 'inet'\n");
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_ERROR);
  }

  /* get required host  */
  host = Tcl_GetStringFromObj(objv[2], NULL);

  /* get optional acl */
  if( objc >= 4 ){
    s = Tcl_GetStringFromObj(objv[3], NULL);
    if( !strcmp(s, "-proxy") ){
      mode="proxy=true";
    }
    else{
      acl = s;
    }
  }

  /* get optional -proxy switch */
  if( objc == 5 ){
    s = Tcl_GetStringFromObj(objv[4], NULL);
    if( !strcmp(s, "-proxy") ){
      mode="proxy=true";
    }
    else if( mode ){
      acl = s;
    }
    else{
      snprintf(tbuf, SZ_LINE,
	      "XPA$ERROR: invalid arg (%s): xpa -remote host [acl] [-proxy]\n",
	      s);
      Tcl_SetStringObj(resultPtr, tbuf, -1);
      return(TCL_ERROR);
    }
  }

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* set up the tcl handler for the xpa access point */
  got = XPARemote(xpa, host, acl, mode);
  if( got >= 0 ){
    return(TCL_OK);
  }
  else{
    snprintf(tbuf, SZ_LINE,
	     "XPA$ERROR: remote xpans %s failed to process %s\n",
	     host, xpa->name);
    Tcl_SetStringObj(resultPtr, tbuf, -1);
    return(TCL_ERROR);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAError_Tcl
 *
 * Purpose:	Tcl binding to XPAError procedure
 *
 * Tcl call:
 *
 *     xpaerror xpa errmess
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAError_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAError_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *message;
  XPA xpa;

  /* make sure argument count is correct */
  if( objc != 3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa message");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* get message string */
  message = Tcl_GetStringFromObj(objv[2], NULL);

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* call the XPAError routine */
  XPAError(xpa, message);

  /* no error message (too lazy) */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	XPAMessage_Tcl
 *
 * Purpose:	Tcl binding to XPAMessage procedure
 *
 * Tcl call:
 *
 *     xpamessage xpa errmess
 *
 * Returns:	Tcl error code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
static int
XPAMessage_Tcl(ClientData clientData, Tcl_Interp *interp,
	   int objc, Tcl_Obj *CONST objv[])
#else
static int XPAMessage_Tcl(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
#endif
{
  char *message;
  XPA xpa;

  /* make sure argument count is correct */
  if( objc != 3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "xpa message");
    return(TCL_ERROR);
  }

  /* get xpa, which is always arg 1 */
  if( Tcl_GetXPAFromObj(interp, objv[1], TY_SERVER, &xpa) != TCL_OK){
    return(TCL_ERROR);
  }

  /* get message string */
  message = Tcl_GetStringFromObj(objv[2], NULL);

  /* reset error/result condition */
  Tcl_ResetResult(interp);

  /* call the XPAMessage routine */
  XPAMessage(xpa, message);

  /* no error message (too lazy) */
  return(TCL_OK);
}

/*
 *----------------------------------------------------------------------------
 *
 *
 * 			Public Routines and Data
 *
 *
 *----------------------------------------------------------------------------
 */

/*
 *----------------------------------------------------------------------------
 *
 * Routine:	Xpa_Init
 *
 * Purpose:	initialize Tcl xpa package
 *
 * Returns:	tcl return code
 *
 *----------------------------------------------------------------------------
 */
#ifdef ANSI_FUNC
int
Tclxpa_Init (void *vinterp)
#else
int Tclxpa_Init (vinterp)
     void *vinterp;
#endif
{
  Tcl_Interp *interp = (Tcl_Interp *)vinterp;

  if(
#ifdef USE_TCL_STUBS
     Tcl_InitStubs(interp, "8.4", 0)
#else
     Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
#endif
     == NULL) {
    return TCL_ERROR;
  }

  /* add xpa commands to this interpreter */
  Tcl_CreateObjCommand(interp, "xpanew", XPANew_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpafree", XPAFree_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpainfonew", XPAInfoNew_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpacmdnew", XPACmdNew_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpacmddel", XPACmdDel_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpacmdadd", XPACmdAdd_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xparec", XPARec_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpasetbuf", XPASetBuf_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaopen", XPAOpen_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaclose", XPAClose_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaget", XPAGet_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpagetfd", XPAGetFd_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaset", XPASet_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpasetfd", XPASetFd_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpainfo", XPAInfo_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaaccess", XPAAccess_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpanslookup", XPANSLookup_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpanskeepalive", XPANSKeepAlive_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xparemote", XPARemote_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpaerror", XPAError_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_CreateObjCommand(interp, "xpamessage", XPAMessage_Tcl,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_PkgProvide(interp, "tclxpa", "2.1");
  return(TCL_OK);
}

/* required for tclkit 8.6 */
Tclxpa_Unload() {}
Tclxpa_SafeUnload() {}
Tclxpa_SafeInit() {}


int xpa_tclbinding = 1;

#else

int xpa_tclbinding = 0;

#endif