/*************************************************************************\
 * Copyright (c) 2002 The University of Chicago, as Operator of Argonne
 * National Laboratory.
 * Copyright (c) 2002 The Regents of the University of California, as
 * Operator of Los Alamos National Laboratory.
 * This file is distributed subject to a Software License Agreement found
 * in the file LICENSE that is included with this distribution.
\*************************************************************************/

#include <stdlib.h>
#include <alarmString.h>
/*#include <alarm.h>*/
#include <time.h>
#include <ellLib.h>

#include <tclCa.h>
/*#include <tsDefs.h>*/

#if ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)) || (TCL_MAJOR_VERSION > 8)
#  define CACONST const
#else
#  define CACONST
#endif

static short FDINIT;
static char *ss[] = {"NE", "NC", "LC", "RD", "WR", "IO", "OK"};
static char *fmt[] = {"%.5g", "%.1lg", "%.2lg", "%.3lg",
  "%.4lg", "%.5lg", "%.6lg", "%.7lg",
  "%.8lg", "%.9lg", "%.10lg", "%.11lg",
  "%.12lg", "%.13lg", "%.14lg", "%.15lg",
  "%.12lg", "%.13lg", "%.14lg", "%.15lg",
  "%.16lg", "%.17lg", "%.18lg", "%.19lg"};

typedef struct {
  ELLNODE nodePad;
  int index;
  ITEM *pitem;
} ITEMNODE;

/* Used in tclCaLink to remove need for multiple passes
   of hashing on the same item. */
static ELLLIST itemList;

typedef struct EvalEvent EvalEvent;
struct EvalEvent {
  Tcl_Event base; /* Base class of type Tcl_Event */
  CHANDATA *pch;
};

/*****************************/
/* Local Function Prototypes */
/*****************************/
int caTypeToTclType(int caNativeType, int elements);
void connectionHandler(struct connection_handler_args args);
void updateChCtrlPrep(struct event_handler_args args);
static int updateChCtrl(Tcl_Event *evPtr, int flags);
void updateLink(CHANDATA *pchandata);
void exceptionHandler(struct exception_handler_args arg);
void putCh(struct event_handler_args args);
void updateChPrep(struct event_handler_args args);
static int updateCh(Tcl_Event *evPtr, int flags);
void updateGetChPrep(struct event_handler_args args);
static int updateGetCh(Tcl_Event *evPtr, int flags);
void updateInterpVar(CHANDATA *pch);
void copyCaTypeToTclType(CHANDATA *pch);
void copyInfoValueToData(CHANDATA *pch);
void *copyTclTypeToCaType(Tcl_Interp *interp, CHANDATA *pch);
int howManyBytes(CHANDATA *pchandata);
void registerFD(void *dummy, int fd, int condition);
void epicsFdMonitor(void *dummy, int mask);
static void pendRecycleProc(ClientData clientData);
#if defined(USE_BLT)
void copyNativeValuesToVector(CHANDATA *pch);
void copyVectorValuesToNative(CHANDATA *pch);
#endif

/******************************************
 * link a pv to a tcl variable & connect to IOC
 *****************************************/
int tclCaLink(Tcl_Interp *interp, char *tclNameList, char *pvNameList,
              int waitFlag, float pendioTime, int blunderAhead, int UseCatch) {

  ITEM *pitem;
  int status, nBytes, newPv;
  CHANDATA *pchandata = NULL;
  int index, listArgctcl, listArgcpv;
  char **listArgvtcl;
  char **listArgvpv;
  ITEMNODE *itemNode;
  long k;
  Tcl_Obj *listObj, *obj, *listName, *listObj2, *listName2;
  int multilistedPV, i;

  listObj = listName = listObj2 = listName2 = NULL;
  if (FDINIT != 1) {
    FDINIT = 1;
    status = ca_task_initialize();
    if (status != ECA_NORMAL) {
      if (UseCatch) {
        Tcl_SetResult(interp, "ca initialize: ", TCL_STATIC);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "ca initialize: ", (char *)NULL);
        return (-1);
      }
    }

    status = ca_add_exception_event(exceptionHandler, NULL);
    if (status != ECA_NORMAL) {
      if (UseCatch) {
        Tcl_SetResult(interp, "ca add_exception_event: ", TCL_STATIC);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "ca add_exception_event: ", (char *)NULL);
        return (-1);
      }
    }

    status = ca_add_fd_registration(registerFD, NULL);
    if (status != ECA_NORMAL) {
      if (UseCatch) {
        Tcl_SetResult(interp, "FD Registration: ", TCL_STATIC);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "FD Registration: ", (char *)NULL);
        return (-1);
      }
    }
    status = ca_pend_io(pendioTime);
    if (status != ECA_NORMAL) {
      if (UseCatch) {
        Tcl_SetResult(interp, "FD Registration: ", TCL_STATIC);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "FD Registration: ", (char *)NULL);
        return (-1);
      }
    }
    Tcl_CreateTimerHandler(100, pendRecycleProc, NULL);
  }

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }
  if (Tcl_SplitList(interp, pvNameList, &listArgcpv, (CACONST char ***)&listArgvpv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "pv:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv:splitList: ", (char *)NULL);
      return (-1);
    }
  }
  if (listArgctcl != listArgcpv) {
    if (UseCatch) {
      Tcl_SetResult(interp, "List size mismatch: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "List size mismatch", (char *)NULL);
      return (-1);
    }
  }

  ellInit(&itemList);

  index = 0;
  pitem = NULL;
  while (index < listArgctcl) {
    pitem = pv_search(listArgvtcl[index]);
    if (pitem == NULL) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "HASH:error: ", listArgvtcl[index], NULL);
        ellFree(&itemList);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "HASH:error: ", listArgvtcl[index],
                         (char *)NULL);
        ellFree(&itemList);
        return (-1);
      }
    }
    newPv = 0;
    pchandata = pitem->pchandata;

    multilistedPV = 0;
    for (i = 0; i < index; i++) {
      if (strcmp(listArgvtcl[index], listArgvtcl[i]) == 0) {
        if (strcmp(listArgvpv[index], listArgvpv[i]) == 0) {
          multilistedPV = 1;
        } else {
          if (UseCatch) {
            Tcl_AppendResult(interp, "Tcl var listed more than once: ", listArgvtcl[index], NULL);
            ellFree(&itemList);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, "Tcl var listed more than once: ", listArgvtcl[index],
                             (char *)NULL);
            ellFree(&itemList);
            return (-1);
          }
        }
      }
    }

    if ((multilistedPV == 0) &&
        (pchandata->castate == NewConnection ||
         pchandata->castate == NeverConnected ||
         (newPv = strcmp(listArgvpv[index], ca_name(pchandata->chid))))) {
      itemNode = (ITEMNODE *)malloc(sizeof(ITEMNODE));
      itemNode->pitem = pitem;
      itemNode->index = index;
      ellAdd(&itemList, (ELLNODE *)itemNode);
      /* If we're linking same tcl var to a new pv, free up ca resources. */
      if (newPv) {
        if (pchandata->evid != NULL) {
          status = ca_clear_event(pchandata->evid);
          pchandata->evid = NULL;
          if (pchandata->pscript != NULL) {
            if (pchandata->pscript->number == 1) {
              Tcl_DStringFree(&pchandata->pscript->script);
              free(pchandata->pscript);
            } else {
              --pchandata->pscript->number;
            }
            pchandata->pscript = NULL;
          }
        }
        free(pchandata->pdata);
        Tcl_UnlinkVar(interp, listArgvtcl[index]);
        Tcl_UnsetVar(interp, listArgvtcl[index], 0);
        if (pchandata->iType == DBF_STRING ||
            pchandata->iType == DBF_ENUM) {
          ckfree(pchandata->tclValue.tclStr);
        }
        ca_clear_channel(pchandata->chid);
      }

      /* NewConnection or retry on NeverConnected */
#if defined(USE_BLT)
      pchandata->pvec = NULL;
#endif
      pchandata->castate = NeverConnected;
      pchandata->pitem = pitem;
      pchandata->interp = interp;
      pchandata->parent = Tcl_GetCurrentThread();
      pchandata->info = NULL;
      if (waitFlag) {
        status = ca_search(listArgvpv[index], &(pchandata->chid));
        if (status != ECA_NORMAL) {
          if (UseCatch) {
            Tcl_AppendResult(interp, "Search: ", listArgvpv[index], NULL);
            ckfree((char *)listArgvtcl);
            ckfree((char *)listArgvpv);
            ellFree(&itemList);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, "Search: ", listArgvpv[index], (char *)NULL);
            ckfree((char *)listArgvtcl);
            ckfree((char *)listArgvpv);
            ellFree(&itemList);
            return (-1);
          }
        }
        ca_set_puser(pchandata->chid, pchandata);

      } else { /* async */
        status = ca_search_and_connect(listArgvpv[index],
                                       &(pchandata->chid),
                                       connectionHandler,
                                       pchandata);
        if (status != ECA_NORMAL) {
          if (UseCatch) {
            Tcl_AppendResult(interp, "async connect  ", listArgvpv[index], NULL);
            ckfree((char *)listArgvtcl);
            ckfree((char *)listArgvpv);
            ellFree(&itemList);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, "async connect  ", listArgvpv[index],
                             (char *)NULL);
            ckfree((char *)listArgvtcl);
            ckfree((char *)listArgvpv);
            ellFree(&itemList);
            return (-1);
          }
        }
        ca_set_puser(pchandata->chid, pchandata);
      }
    }
    index++;
  } /* end while */

  if (waitFlag) {
    status = ca_pend_io(pendioTime);
    if ((status != ECA_NORMAL) && (blunderAhead != 1)) {
      /* NOTE: build up string of all pv's here, since I am now doing one
         big pend_io, and therefore don't know which failed specifically.
      */
      if (UseCatch) {
        Tcl_AppendResult(interp, "Search Pend-IO: ", "ALL", NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvpv);
        ellFree(&itemList);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "Search Pend-IO: ", "ALL",
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvpv);
        ellFree(&itemList);
        return (-1);
      }
    }

    /* Channel access connections completed. Now scan over pv's again
       to get ca DBR_CTRL information. */
    itemNode = (ITEMNODE *)ellFirst(&itemList);
    while (itemNode != NULL) {
      pitem = itemNode->pitem;
      pchandata = pitem->pchandata;
      pchandata->iType = (int)ca_field_type(pchandata->chid);
      pchandata->tclType = caTypeToTclType(pchandata->iType, ca_element_count(pchandata->chid));
      pchandata->skip = 0;
      if (!ca_read_access(pchandata->chid)) {
        if (blunderAhead == 1) {
          pchandata->skip = 1;
          itemNode = (ITEMNODE *)ellNext(&itemNode->nodePad);
          continue;
        }
        pchandata->castate = ReadAccess;
        itemNode = (ITEMNODE *)ellNext(&itemNode->nodePad);
        continue;
      }
      pchandata->info = (INFOBUF *)malloc(sizeof(INFOBUF) * ca_element_count(pchandata->chid));

      if (ca_field_type(pchandata->chid) == DBF_STRING) {
        status = ca_array_get(
                              dbf_type_to_DBR_STS(ca_field_type(pchandata->chid)),
                              ca_element_count(pchandata->chid), pchandata->chid, pchandata->info);
      } else {
        status = ca_array_get(
                              dbf_type_to_DBR_CTRL(ca_field_type(pchandata->chid)),
                              ca_element_count(pchandata->chid), pchandata->chid, pchandata->info);
      }

      itemNode = (ITEMNODE *)ellNext(&itemNode->nodePad);
    } /* end while */

    status = ca_pend_io(pendioTime);
    if ((status != ECA_NORMAL) && (blunderAhead != 1)) {
      ca_clear_channel(pchandata->chid);
      /* NOTE: need to build up list here. */
      if (UseCatch) {
        Tcl_AppendResult(interp, "sync get info  Pend-IO: ",
                         "ALL", NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvpv);
        ellFree(&itemList);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "sync get info  Pend-IO: ",
                         "ALL", (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvpv);
        ellFree(&itemList);
        return (-1);
      }
    }

    /* Channel access control information retrieved, now initialize
       connection handler, chandata struct and link to tcl var. */
    k = -1;
    if (blunderAhead == 1) {
      listObj = Tcl_NewListObj(0, NULL);
      listObj2 = Tcl_NewListObj(0, NULL);
      listName = Tcl_NewObj();
      listName2 = Tcl_NewObj();
      Tcl_SetStringObj(listName, "errorTclNameList", -1);
      Tcl_SetStringObj(listName2, "errorTclNameIndex", -1);
    }
    itemNode = (ITEMNODE *)ellFirst(&itemList);
    while (itemNode != NULL) {
      k++;
      pitem = itemNode->pitem;
      pchandata = pitem->pchandata;
      if ((blunderAhead == 1) && (pchandata->skip == 1)) {
        obj = Tcl_NewObj();
        Tcl_SetStringObj(obj, pitem->tclname, strlen(pitem->tclname));
        Tcl_ListObjAppendList(interp, listObj, obj);
        obj = Tcl_NewObj();
        Tcl_SetLongObj(obj, k);
        Tcl_ListObjAppendList(interp, listObj2, obj);
        itemNode = (ITEMNODE *)ellNext(&itemNode->nodePad);
        continue;
      }
      pchandata->castate = ConnectionOK;

      status = ca_change_connection_event(pchandata->chid, connectionHandler);
      if (status != ECA_NORMAL) {
        ca_clear_channel(pchandata->chid);
        pchandata->castate = NeverConnected;
        if (UseCatch) {
          Tcl_AppendResult(interp, "No connection handler: ",
                           listArgvpv[itemNode->index], NULL);
          ckfree((char *)listArgvtcl);
          ckfree((char *)listArgvpv);
          ellFree(&itemList);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "No connection handler: ",
                           listArgvpv[itemNode->index], (char *)NULL);
          ckfree((char *)listArgvtcl);
          ckfree((char *)listArgvpv);
          ellFree(&itemList);
          return (-1);
        }
      }
      nBytes = howManyBytes(pchandata);
      if (nBytes == -1) {
        ca_clear_channel(pchandata->chid);
        pchandata->castate = NeverConnected;
        if (UseCatch) {
          Tcl_AppendResult(interp, "unknown type ", listArgvpv[itemNode->index], NULL);
          ckfree((char *)listArgvtcl);
          ckfree((char *)listArgvpv);
          ellFree(&itemList);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "unknown type ", listArgvpv[itemNode->index],
                           (char *)NULL);
          ckfree((char *)listArgvtcl);
          ckfree((char *)listArgvpv);
          ellFree(&itemList);
          return (-1);
        }
      }
      pchandata->initSize = nBytes;
      updateLink(pchandata);
      updateInterpVar(pchandata);

      itemNode = (ITEMNODE *)ellNext(&itemNode->nodePad);
    } /* end while */

  } else { /* async */
    status = ca_flush_io();
  }
  if (blunderAhead == 1) {
    Tcl_ObjSetVar2(interp, listName, NULL, listObj, TCL_LEAVE_ERR_MSG);
    Tcl_ObjSetVar2(interp, listName2, NULL, listObj2, TCL_LEAVE_ERR_MSG);
  }
  ckfree((char *)listArgvtcl);
  ckfree((char *)listArgvpv);
  ellFree(&itemList);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/******************************************
 * Unlink tcl variable from pv and free up
 * channel access connection.
 *****************************************/
int tclCaUnLink(Tcl_Interp *interp, char *tclNameList, int UseCatch) {

  ITEM *pitem;
  int status;
  CHANDATA *pchandata;
  int index, listArgctcl;
  char **listArgvtcl;

  if (FDINIT != 1) {
    if (UseCatch) {
      return TCL_OK;
    } else {
      return (0);
    }
  }

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "pv ", "NOT LINKED ", listArgvtcl[index], NULL);
      } else {
        Tcl_SetErrorCode(interp, "pv", "NOT LINKED", listArgvtcl[index],
                         (char *)NULL);
      }
      index++;
      continue;
    }

    pchandata = pitem->pchandata;

    /* If this tcl variable was successfully connected at one time. */
    if ((pchandata->castate != NewConnection) &&
        (pchandata->castate != NeverConnected)) {

      if (pchandata->evid != NULL) {
        status = ca_clear_event(pchandata->evid);
        pchandata->evid = NULL;
        if (pchandata->pscript != NULL) {
          if (pchandata->pscript->number == 1) {
            Tcl_DStringFree(&pchandata->pscript->script);
            free(pchandata->pscript);
          } else {
            --pchandata->pscript->number;
          }
          pchandata->pscript = NULL;
        }
      }
      free(pchandata->pdata);
      if (pchandata->iType == DBF_STRING ||
          pchandata->iType == DBF_ENUM) {
        ckfree(pchandata->tclValue.tclStr);
      }
      ca_clear_channel(pchandata->chid);
    }

    /* Free up tcl var, associated data structs, and hash table entry. */
    Tcl_UnlinkVar(interp, listArgvtcl[index]);
    Tcl_UnsetVar(interp, listArgvtcl[index], 0);
    pv_delete(listArgvtcl[index]);
#if defined(USE_BLT)
    if (pitem->vecname != NULL && Blt_VectorExists(interp, pitem->vecname)) {
      Blt_DeleteVectorByName(interp, pitem->vecname);
    }
    if (pitem->vecname != NULL) {
      free(pitem->vecname);
      free(pchandata->pvec);
      pitem->vecname = NULL;
    }
#endif
    free(pchandata);
    if (pitem->tclname)
      free(pitem->tclname);
    free(pitem);

    index++;
  } /* end while */

  status = ca_pend_io(CA_PEND_IO_TIME);
  ckfree((char *)listArgvtcl);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

int tclCaExit(Tcl_Interp *interp, int UseCatch) {
  int status;
  if (FDINIT != 1) {
    if (UseCatch) {
      return TCL_OK;
    } else {
      return (0);
    }
  }
  status = ca_task_exit();
  if (status != ECA_NORMAL) {
    if (UseCatch) {
      Tcl_SetResult(interp, "ca_task_exit: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "ca_task_exit: ", (char *)NULL);
      return (-1);
    }
  }
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/******************************************
 * Map native channel access type on to
 * appropriate tcl data type.
 *****************************************/
int caTypeToTclType(int caNativeType, int elements) {
  if (elements > 1)
    return TCL_LINK_STRING;
  switch (caNativeType) {
  case DBF_STRING:
    return TCL_LINK_STRING;
  case DBF_ENUM:
    return TCL_LINK_STRING;
  case DBF_CHAR:
    return TCL_LINK_INT;
  case DBF_INT:
    return TCL_LINK_INT;
  case DBF_LONG:
    return TCL_LINK_INT;
  case DBF_FLOAT:
    return TCL_LINK_DOUBLE;
  case DBF_DOUBLE:
    return TCL_LINK_DOUBLE;
  default:
    return TCL_LINK_DOUBLE;
  }
}

/******************************************
 * connection event handler
 *****************************************/
void connectionHandler(struct connection_handler_args args) {

  CHANDATA *pch;
  int status, nBytes;
  pch = (CHANDATA *)ca_puser(args.chid);

  switch (args.op) {
  case CA_OP_CONN_UP:
    if (pch->castate == NeverConnected) {
      if (pch->info == NULL)
        pch->info = (INFOBUF *)malloc(sizeof(INFOBUF) * ca_element_count(pch->chid));

      if (!ca_read_access(pch->chid)) {
        pch->castate = ReadAccess;
        break;
      }
      pch->iType = (int)ca_field_type(pch->chid);
      pch->tclType = caTypeToTclType(pch->iType, ca_element_count(pch->chid));
      nBytes = howManyBytes(pch);
      if (pch->iType == DBF_STRING) {
        status = ca_array_get_callback(
                                       dbf_type_to_DBR_STS(pch->iType),
                                       ca_element_count(pch->chid),
                                       pch->chid,
                                       updateChCtrlPrep,
                                       (void *)pch);
        if (status != ECA_NORMAL) {
          ca_clear_channel(pch->chid);
        }
      } else {
        status = ca_array_get_callback(
                                       dbf_type_to_DBR_CTRL(pch->iType),
                                       ca_element_count(pch->chid),
                                       pch->chid,
                                       updateChCtrlPrep,
                                       (void *)pch);
        if (status != ECA_NORMAL) {
          ca_clear_channel(pch->chid);
        }
      }
    } else {
      pch->castate = ConnectionOK;
      pch->countPendIO = 0;
    }
    break;
  case CA_OP_CONN_DOWN:
    pch->castate = LostConnection;
    break;
  }

  return;
}

/*******************************************************
 * whenever async cntl data is received...retrieve info buffer
 *******************************************************/
void updateChCtrlPrep(struct event_handler_args args) {
  EvalEvent *pEvent;
  CHANDATA *pch;
  int nBytes;
  pch = (CHANDATA *)args.usr;

  pEvent = ckalloc(sizeof(EvalEvent));
  pEvent->base.nextPtr = 0;
  pEvent->base.proc = updateChCtrl;
  pEvent->pch = args.usr;
  nBytes = dbr_size_n(args.type, args.count);
  memcpy((char *)pEvent->pch->info, args.dbr, (size_t)nBytes);

  Tcl_ThreadQueueEvent(pch->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
  Tcl_ThreadAlert(pch->parent);
}

static int updateChCtrl(Tcl_Event *evPtr, int flags) {
  EvalEvent *pEvent = (EvalEvent *)evPtr;
  CHANDATA *pch;

  pch = (CHANDATA *)pEvent->pch;

  pch->initSize = howManyBytes(pch);
  updateLink(pch);
  updateInterpVar(pch);
  return 1;
}

/*******************************************************
 * With INFOBUF in hand, update chandata with data
 * necessary for link
 *******************************************************/
void updateLink(CHANDATA *pch) {
  pch->castate = ConnectionOK;
  pch->pdata = (DATABUF *)calloc(1, pch->initSize);
  if (pch->iType == DBF_STRING || pch->iType == DBF_ENUM) {
    pch->tclValue.tclStr = NULL;
  }
  Tcl_LinkVar(pch->interp, pch->pitem->tclname,
              (char *)&pch->tclValue, pch->tclType);

  copyInfoValueToData(pch);
  copyCaTypeToTclType(pch);
}

/******************************************
 * exception event handler
 *****************************************/
void exceptionHandler(struct exception_handler_args arg) {

  chid pCh;
  int stat;

  pCh = arg.chid;
  stat = arg.stat;
  (void)printf("CA exception handler entered\n");
  if (pCh) {
    (void)printf("CA channel name=%s\n", ca_name(pCh));
  }
  (void)printf("CA status=%s\n", ca_message(stat));
  (void)printf("CA context=%s\n", arg.ctx);
  (void)printf("CA op=%ld data type=%s count=%ld\n",
               arg.op,
               dbr_type_to_text(arg.type),
               arg.count);
}

/******************************************
 * monitor a pv
 *****************************************/
int tclCaMon(Tcl_Interp *interp, char *tclNameList,
             char *pcommand, int updateVar, int UseCatch) {

  ITEM *pitem;
  CHANDATA *pchandata;
  int status, notFoundFlag;
  int index, listArgc;
  char **listArgv;
  Tcl_DString dsPtr;
  MONSCRIPT *pscript = NULL;

  if (Tcl_SplitList(interp, tclNameList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);
  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&dsPtr, listArgv[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  if (pcommand != NULL) {
    pscript = (MONSCRIPT *)calloc(1, sizeof(MONSCRIPT));
    Tcl_DStringInit(&pscript->script);
    Tcl_DStringAppend(&pscript->script, pcommand, -1);
    pscript->number = 0;
  } else {
    pscript = NULL;
  }
  index = 0;
  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    pchandata = pitem->pchandata;
    if (pchandata->castate == NeverConnected) {
      index++;
      continue;
    } else if (pchandata->castate == LostConnection) {
      index++;
      continue;
    } else if (pchandata->evid != NULL) {
      index++;
      continue;
    } else {
      status = ca_add_array_event(
                                  dbf_type_to_DBR_TIME(pchandata->iType),
                                  ca_element_count(pchandata->chid),
                                  pchandata->chid,
                                  updateChPrep,
                                  pchandata,
                                  (float)0, (float)0, (float)0,
                                  &(pchandata->evid));
      if (status != ECA_NORMAL) {
        if (UseCatch) {
          Tcl_AppendResult(interp, "CA:add event: ", listArgv[index], NULL);
          ckfree((char *)listArgv);
          if (pscript != NULL && pscript->number == 0) {
            Tcl_DStringFree(&pscript->script);
            free((char *)pscript);
          }
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "CA:add event: ", listArgv[index],
                           (char *)NULL);
          ckfree((char *)listArgv);
          if (pscript != NULL && pscript->number == 0) {
            Tcl_DStringFree(&pscript->script);
            free((char *)pscript);
          }
          return (-1);
        }
      }
      pchandata->updateVar = updateVar;
      pchandata->pscript = pscript;
      if (pscript != NULL) {
        pscript->number++;
      }
    }
    index++;
  } /* end while */

  ckfree((char *)listArgv);
  if (pscript != NULL && pscript->number == 0) {
    Tcl_DStringFree(&pscript->script);
    free(pscript);
  }

  status = ca_pend_io(CA_PEND_IO_TIME);
  if (status != ECA_NORMAL) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "CA:add event PENDIO: ", listArgv[index], NULL);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "CA:add event PENDIO: ", listArgv[index],
                       (char *)NULL);
      return (-1);
    }
  }
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/******************************************
 * clear a monitor a pv
 *****************************************/
int tclCaCmon(Tcl_Interp *interp, char *tclNameList, int UseCatch) {

  ITEM *pitem;
  CHANDATA *pch;
  int status;
  int index, listArgc;
  char **listArgv;
  Tcl_DString newList;
  int notFoundFlag;

  if (Tcl_SplitList(interp, tclNameList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&newList);

  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&newList, listArgv[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&newList), NULL);
      ckfree((char *)listArgv);
      Tcl_DStringFree(&newList);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&newList),
                       (char *)NULL);
      ckfree((char *)listArgv);
      Tcl_DStringFree(&newList);
      return (-1);
    }
  }
  Tcl_DStringFree(&newList);
  index = 0;
  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    pch = pitem->pchandata;
    if (pch->evid != NULL) {
      status = ca_clear_event(pch->evid);
      pch->evid = NULL;
      if (pch->pscript != NULL) {
        pch->pscript->number--;
        if (pch->pscript->number == 0) {
          Tcl_DStringFree(&pch->pscript->script);
          free(pch->pscript);
        }
        pch->pscript = NULL;
        pch->secondMonEvent = 0;
      }
    }
    index++;
  }
  status = ca_pend_io(CA_PEND_IO_TIME);
  ckfree((char *)listArgv);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/*******************************************************
 * whenever async data is sent...mark that it is complete
 *******************************************************/
void putCh(struct event_handler_args args) {

  CHANDATA *pch;
  pch = (CHANDATA *)args.usr;
  /*putw i.e put with callbacks works funny doesn't complete until
    a later pend-io is done
    doesn't get called back with a pend event
    FIXED in 3.12
  */
  if (pch->countPendIO > 0)
    pch->countPendIO--;
  if (pch->countPendIO == 0)
    pch->castate = ConnectionOK;
}

/*******************************************************
 * whenever async data is received...retrieve data & fill
 * in TCL asociated variable and if exists the vector
 *******************************************************/
void updateChPrep(struct event_handler_args args) {
  EvalEvent *pEvent;
  CHANDATA *pch;
  int nBytes;
  pch = (CHANDATA *)args.usr;

  pEvent = ckalloc(sizeof(EvalEvent));
  pEvent->base.nextPtr = 0;
  pEvent->base.proc = updateCh;
  pEvent->pch = args.usr;
  nBytes = dbr_size_n(args.type, args.count);
  if (nBytes <= pEvent->pch->initSize) {
    pEvent->pch->dataSize = nBytes;
  } else {
    pEvent->pch->dataSize = pEvent->pch->initSize;
    nBytes = pEvent->pch->initSize;
  }
  memcpy((char *)pEvent->pch->pdata, args.dbr, (size_t)nBytes);

  Tcl_ThreadQueueEvent(pch->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
  Tcl_ThreadAlert(pch->parent);
}

static int updateCh(Tcl_Event *evPtr, int flags) {
  EvalEvent *pEvent = (EvalEvent *)evPtr;
  CHANDATA *pch;

  pch = (CHANDATA *)pEvent->pch;

  copyCaTypeToTclType(pch);
#if defined(USE_BLT)
  copyNativeValuesToVector(pch);
#endif

  if (pch->evid == NULL) {
    if (pch->countPendIO > 0)
      pch->countPendIO--;
    if (pch->countPendIO == 0)
      pch->castate = ConnectionOK;

  } else {
    pch->castate = ConnectionOK;
    if (pch->updateVar)
      updateInterpVar(pch);
    if (pch->pscript != NULL) {
      if (pch->secondMonEvent) {
        Tcl_GlobalEval(pch->interp, Tcl_DStringValue(&pch->pscript->script));
      } else {
        pch->secondMonEvent = 1;
      }
    }
  }
  return 1;
}

/*******************************************************
 * whenever async data is received...retrieve data & fill
 * in TCL asociated variable and if exists the vector
 *******************************************************/
void updateGetChPrep(struct event_handler_args args) {
  EvalEvent *pEvent;
  CHANDATA *pch;
  int nBytes;
  pch = (CHANDATA *)args.usr;

  pEvent = ckalloc(sizeof(EvalEvent));
  pEvent->base.nextPtr = 0;
  pEvent->base.proc = updateGetCh;
  pEvent->pch = args.usr;
  nBytes = dbr_size_n(args.type, args.count);
  if (nBytes <= pEvent->pch->initSize) {
    pEvent->pch->dataSize = nBytes;
  } else {
    pEvent->pch->dataSize = pEvent->pch->initSize;
    nBytes = pEvent->pch->initSize;
  }
  memcpy((char *)pEvent->pch->pdata, args.dbr, (size_t)nBytes);

  Tcl_ThreadQueueEvent(pch->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
  Tcl_ThreadAlert(pch->parent);
}

static int updateGetCh(Tcl_Event *evPtr, int flags) {
  EvalEvent *pEvent = (EvalEvent *)evPtr;
  CHANDATA *pch;

  pch = (CHANDATA *)pEvent->pch;

  copyCaTypeToTclType(pch);
#if defined(USE_BLT)
  copyNativeValuesToVector(pch);
#endif
  updateInterpVar(pch);

  if (pch->countPendIO > 0)
    pch->countPendIO--;
  if (pch->countPendIO == 0)
    pch->castate = ConnectionOK;
  return 1;
}

/*******************************************************
 * updateInterpVar
 * when a monitor triggers
 * update the value in tcl Interperter
 * so that Tk text updates etc can do their job
 *******************************************************/
void updateInterpVar(CHANDATA *pch) {
  /* Skip this for string types, since already done in copyCaTypeToTclType() */
  if (ca_element_count(pch->chid) == 1) {
    if (pch->iType != DBF_STRING && pch->iType != DBF_ENUM) {
      Tcl_UpdateLinkedVar(pch->interp, pch->pitem->tclname);
    }
  }
}

/*******************************************************
 * Copy value field of infobuf to value field of databuf.
 * This allows a pv link operation to set the tcl var with
 * the pv's initial value.
 *******************************************************/
void copyInfoValueToData(CHANDATA *pch) {
  INFOBUF *pinfo = pch->info;
  DATABUF *pdata = pch->pdata;
  int i;
  int nelm = ca_element_count(pch->chid);

  switch (pch->iType) {
  case DBF_STRING:
    for (i = 0; i < nelm; i++) {
      strcpy((&pdata->s.value)[i], (&pinfo->s.value)[i]);
    }
    pdata->s.status = pinfo->s.status;
    pdata->s.severity = pinfo->s.severity;
    break;
  case DBF_ENUM:
    for (i = 0; i < nelm; i++) {
      (&pdata->e.value)[i] = (&pinfo->e.value)[i];
    }
    pdata->e.status = pinfo->e.status;
    pdata->e.severity = pinfo->e.severity;
    break;
  case DBF_CHAR:
    for (i = 0; i < nelm; i++) {
      (&pdata->c.value)[i] = (long)((&pinfo->c.value)[i]);
    }
    pdata->c.status = pinfo->c.status;
    pdata->c.severity = pinfo->c.severity;
    break;
  case DBF_INT:
    for (i = 0; i < nelm; i++) {
      (&pdata->i.value)[i] = (long)((&pinfo->i.value)[i]);
    }
    pdata->i.status = pinfo->i.status;
    pdata->i.severity = pinfo->i.severity;
    break;
  case DBF_LONG:
    for (i = 0; i < nelm; i++) {
      (&pdata->l.value)[i] = (long)((&pinfo->l.value)[i]);
    }
    pdata->l.status = pinfo->l.status;
    pdata->l.severity = pinfo->l.severity;
    break;
  case DBF_FLOAT:
    for (i = 0; i < nelm; i++) {
      (&pdata->f.value)[i] = (double)((&pinfo->f.value)[i]);
    }
    pdata->f.status = pinfo->f.status;
    pdata->f.severity = pinfo->f.severity;
    break;
  case DBF_DOUBLE:
    for (i = 0; i < nelm; i++) {
      (&pdata->d.value)[i] = (double)((&pinfo->d.value)[i]);
    }
    pdata->d.status = pinfo->d.status;
    pdata->d.severity = pinfo->d.severity;
    break;
  default:
    pdata->d.value = 0.0;
    pdata->d.status = pinfo->d.status;
    pdata->d.severity = pinfo->d.severity;
    break;
  }
}

/*******************************************************
 * Copy ca data to tcl data buffer, performing conversion
 * to closest tcl data type supported.
 *******************************************************/
void copyCaTypeToTclType(CHANDATA *pch) {
  DATABUF *pdata;
  char buf[MAX_STRING_SIZE];

  int i;
  int nelm = ca_element_count(pch->chid);

  Tcl_DString list;

  if (pch->castate < PendIO)
    return;
  Tcl_DStringInit(&list);
  pdata = pch->pdata;
  /* Use Tcl_SetVar for string types so we don't try and copy a new,
     longer string into a previously malloced smaller one. Tcl_SetVar
     does a free/malloc for us.
  */
  switch (pch->iType) {
  case DBF_STRING:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%s", (&pdata->s.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      Tcl_SetVar(pch->interp, pch->pitem->tclname, pch->pdata->s.value,
                 TCL_GLOBAL_ONLY);
    }
    break;
  case DBF_ENUM:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        // FIX THIS. Make the Array ENUM check for invalid index like the scalar ENUM does
        if (strlen(pch->info->e.strs[(long)(&pch->pdata->e.value)[i]]) != 0) {
          Tcl_DStringAppendElement(&list, pch->info->e.strs[(long)(&pch->pdata->e.value)[i]]);
        } else {
          sprintf(buf, "%ld", (long)(&pdata->e.value)[i]);
          Tcl_DStringAppendElement(&list, buf);
        }
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      if ((pch->info->e.no_str == 0) || (pch->pdata->e.value >= pch->info->e.no_str)) {
        sprintf(buf, "%d", pch->pdata->e.value);
        Tcl_SetVar(pch->interp, pch->pitem->tclname, buf,
                   TCL_GLOBAL_ONLY);
      } else {
        Tcl_SetVar(pch->interp, pch->pitem->tclname,
                   pch->info->e.strs[pch->pdata->e.value],
                   TCL_GLOBAL_ONLY);
      }
    }
    break;
  case DBF_CHAR:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%ld", (long)(&pdata->c.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      pch->tclValue.tclLong = (long)pdata->c.value;
    }
    break;
  case DBF_INT:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%ld", (long)(&pdata->i.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      pch->tclValue.tclLong = (long)pdata->i.value;
    }
    break;
  case DBF_LONG:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%ld", (long)(&pdata->l.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      pch->tclValue.tclLong = (long)pdata->l.value;
    }
    break;
  case DBF_FLOAT:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%lf", (double)(&pdata->f.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      pch->tclValue.tclDouble = (double)pdata->f.value;
    }
    break;
  case DBF_DOUBLE:
    if (nelm > 1) {
      for (i = 0; i < nelm; i++) {
        sprintf(buf, "%lf", (double)(&pdata->d.value)[i]);
        Tcl_DStringAppendElement(&list, buf);
      }
      Tcl_SetVar(pch->interp, pch->pitem->tclname, Tcl_DStringValue(&list),
                 TCL_GLOBAL_ONLY);
    } else {
      pch->tclValue.tclDouble = (double)pdata->d.value;
    }
    break;
  default:
    pch->tclValue.tclDouble = 0.0;
    break;
  }
  Tcl_DStringFree(&list);
}

/*******************************************************
 * Copy tcl data to ca data buffer, performing conversion
 * to closest ca data type supported. Return void ptr to
 * data buffer of iType.
 *******************************************************/
void *copyTclTypeToCaType(Tcl_Interp *interp, CHANDATA *pch) {
  DATABUF *pdata;
  int enumInt;
  int enumMatchFound;
  int i, j;
  INFOBUF *ib;
  int nelm = ca_element_count(pch->chid);
  Tcl_Obj *obj = NULL;
  Tcl_Obj *obj2;
  double doubleValue;
  long longValue;
  int intValue;

  pdata = pch->pdata;
  ib = pch->info;

  switch (pch->tclType) {
  case TCL_LINK_STRING:
    if (pch->iType == DBF_STRING) {
      if (nelm > 1)
        obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      else
        obj2 = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (nelm > 1) {
          if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
            return (NULL);
          }
        }
        strcpy((&pdata->s.value)[i], Tcl_GetStringFromObj(obj2, NULL));
      }
      return ((void *)&pdata->s.value);
    } else if (pch->iType == DBF_CHAR) {
      obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
          return (NULL);
        }
        if (Tcl_GetIntFromObj(interp, obj2, &intValue) != TCL_OK) {
          return (NULL);
        }
        (&pdata->c.value)[i] = intValue;
      }
      return ((void *)&pdata->c.value);
    } else if (pch->iType == DBF_INT) {
      obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
          return (NULL);
        }
        if (Tcl_GetIntFromObj(interp, obj2, &intValue) != TCL_OK) {
          return (NULL);
        }
        (&pdata->i.value)[i] = intValue;
      }
      return ((void *)&pdata->i.value);
    } else if (pch->iType == DBF_LONG) {
      obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
          return (NULL);
        }
        if (Tcl_GetLongFromObj(interp, obj2, &longValue) != TCL_OK) {
          return (NULL);
        }
        (&pdata->l.value)[i] = longValue;
      }
      return ((void *)&pdata->l.value);
    } else if (pch->iType == DBF_FLOAT) {
      obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
          return (NULL);
        }
        if (Tcl_GetDoubleFromObj(interp, obj2, &doubleValue) != TCL_OK) {
          return (NULL);
        }
        (&pdata->f.value)[i] = doubleValue;
      }
      return ((void *)&pdata->f.value);
    } else if (pch->iType == DBF_DOUBLE) {
      obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
          return (NULL);
        }
        if (Tcl_GetDoubleFromObj(interp, obj2, &doubleValue) != TCL_OK) {
          return (NULL);
        }
        (&pdata->d.value)[i] = doubleValue;
      }
      return ((void *)&pdata->d.value);
    } else { /* DBF_ENUM */
      /* compare tclValue.tclStr against ib.e.strs[0-no_str] */
      if (nelm > 1)
        obj = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      else
        obj2 = Tcl_NewStringObj(pch->tclValue.tclStr, -1);
      for (i = 0; i < nelm; i++) {
        if (nelm > 1) {
          if (Tcl_ListObjIndex(interp, obj, i, &obj2) != TCL_OK) {
            return (NULL);
          }
        }
        enumMatchFound = 0;
        for (j = 0; j < ib->e.no_str; j++) {
          if (!strncmp(Tcl_GetStringFromObj(obj2, NULL), ib->e.strs[j], MAX_ENUM_STRING_SIZE)) {
            enumMatchFound = 1;
            break;
          }
        }
        if (enumMatchFound) {
          (&pdata->e.value)[i] = j;
        } else if (Tcl_GetInt(pch->interp, Tcl_GetStringFromObj(obj2, NULL), &enumInt) == TCL_OK) {
          (&pdata->e.value)[i] = enumInt;
        } else {
          return (NULL);
        }
      }
      return ((void *)&pdata->e.value);
    }
  case TCL_LINK_INT:
    switch (pch->iType) {
    case DBF_CHAR:
      pdata->c.value = pch->tclValue.tclLong;
      return ((void *)&pdata->c.value);
    case DBF_INT:
      pdata->i.value = pch->tclValue.tclLong;
      return ((void *)&pdata->i.value);
    case DBF_LONG:
      pdata->l.value = pch->tclValue.tclLong;
      return ((void *)&pdata->l.value);
    }

  case TCL_LINK_DOUBLE:
    switch (pch->iType) {
    case DBF_FLOAT:
      pdata->f.value = pch->tclValue.tclDouble;
      return ((void *)&pdata->f.value);
    case DBF_DOUBLE:
      pdata->d.value = pch->tclValue.tclDouble;
      return ((void *)&pdata->d.value);
    }
  }
  return (NULL);
}

/*******************************************************
 * return number of bytes needed to allocate to DATABUF
 *******************************************************/
int howManyBytes(CHANDATA *pchandata) {
  int size, count;
  count = ca_element_count(pchandata->chid);
  size = dbr_size_n((ca_field_type(pchandata->chid) + DBR_TIME_STRING),
                    ca_element_count(pchandata->chid));
  return (size);
}

/******************************************
 * put(w) a pv
 *****************************************/
int tclCaPut(Tcl_Interp *interp, char *tclNameList, int waitFlag,
             int quickFlag, float pendioTime, int UseCatch) {

  int status, notFoundFlag;
  int index, listArgc, len;
  char **listArgv;
  ITEM *pitem;
  CHANDATA *pch;
  CA_SYNC_GID gid;
  Tcl_DString dsPtr;
  void *dataPtr;

  if (Tcl_SplitList(interp, tclNameList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);

  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&dsPtr, listArgv[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  index = 0;
  if (waitFlag && !quickFlag) {
    status = ca_sg_create(&gid);
    if (status != ECA_NORMAL) {
      if (UseCatch) {
        Tcl_SetResult(interp, "ca_sg_create: ", TCL_STATIC);
        ckfree((char *)listArgv);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "ca_sg_create: ", (char *)NULL);
        ckfree((char *)listArgv);
        return (-1);
      }
    }
  }
  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    pch = pitem->pchandata;
    if (pch->castate == NeverConnected) {
      index++;
      continue;
    } else if (pch->castate == LostConnection) {
      index++;
      continue;
    } else if (!ca_write_access(pch->chid)) {
      pch->castate = WriteAccess;
      index++;
      continue;
    } else if (!waitFlag) {
#if defined(USE_BLT)
      copyVectorValuesToNative(pch);
#endif
      if (ca_element_count(pch->chid) > 1) {
        if (Tcl_ListObjLength(interp, Tcl_NewStringObj(pch->tclValue.tclStr, -1), &len) != TCL_OK) {
          if (UseCatch) {
            Tcl_AppendResult(interp, pch->tclValue.tclStr, " Unable to convert to Tcl list: ",
                             listArgv[index], NULL);
            ckfree((char *)listArgv);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, pch->tclValue.tclStr, " Unable to convert to Tcl list: ",
                             listArgv[index], (char *)NULL);
            ckfree((char *)listArgv);
            return (-1);
          }
        }
        if (ca_element_count(pch->chid) != len) {
          if (UseCatch) {
            Tcl_AppendResult(interp, pch->tclValue.tclStr, " Incorrect number of elements: ",
                             listArgv[index], NULL);
            ckfree((char *)listArgv);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, pch->tclValue.tclStr, " Incorrect number of elements: ",
                             listArgv[index], (char *)NULL);
            ckfree((char *)listArgv);
            return (-1);
          }
        }
      }
      dataPtr = copyTclTypeToCaType(interp, pch);
      if (dataPtr) {
        status = ca_array_put_callback(
                                       pch->iType,
                                       ca_element_count(pch->chid),
                                       pch->chid,
                                       dataPtr,
                                       putCh,
                                       (void *)pch);
      } else {
        if (UseCatch) {
          Tcl_AppendResult(interp, " ", pch->tclValue.tclStr, " NOT A NUMBER: ",
                           listArgv[index], NULL);
          ckfree((char *)listArgv);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, " ", pch->tclValue.tclStr, " NOT A NUMBER: ",
                           listArgv[index], (char *)NULL);
          ckfree((char *)listArgv);
          return (-1);
        }
      }
      if (status != ECA_NORMAL) {
        if (UseCatch) {
          Tcl_AppendResult(interp, "ca_put: ", listArgv[index], NULL);
          ckfree((char *)listArgv);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "ca_put: ", listArgv[index], (char *)NULL);
          ckfree((char *)listArgv);
          return (-1);
        }
      }
      pch->castate = PendIO;
      pch->countPendIO++;

    } else { /* waitFlag */
#if defined(USE_BLT)
      copyVectorValuesToNative(pch);
#endif
      if (ca_element_count(pch->chid) > 1) {
        if (Tcl_ListObjLength(interp, Tcl_NewStringObj(pch->tclValue.tclStr, -1), &len) != TCL_OK) {
          if (UseCatch) {
            Tcl_AppendResult(interp, pch->tclValue.tclStr, " Unable to convert to Tcl list: ",
                             listArgv[index], NULL);
            ckfree((char *)listArgv);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, pch->tclValue.tclStr, " Unable to convert to Tcl list: ",
                             listArgv[index], (char *)NULL);
            ckfree((char *)listArgv);
            return (-1);
          }
        }
        if (ca_element_count(pch->chid) != len) {
          if (UseCatch) {
            Tcl_AppendResult(interp, pch->tclValue.tclStr, " Incorrect number of elements: ",
                             listArgv[index], NULL);
            ckfree((char *)listArgv);
            return TCL_ERROR;
          } else {
            Tcl_SetErrorCode(interp, pch->tclValue.tclStr, " Incorrect number of elements: ",
                             listArgv[index], (char *)NULL);
            ckfree((char *)listArgv);
            return (-1);
          }
        }
      }
      dataPtr = copyTclTypeToCaType(interp, pch);
      if (dataPtr) {
        if (!quickFlag) {
          status = ca_sg_array_put(
                                   gid,
                                   pch->iType,
                                   ca_element_count(pch->chid),
                                   pch->chid,
                                   dataPtr);
        } else {
          status = ca_array_put(
                                pch->iType,
                                ca_element_count(pch->chid),
                                pch->chid,
                                dataPtr);
        }
      } else {
        if (UseCatch) {
          Tcl_AppendResult(interp, " ", pch->tclValue.tclStr, " NOT A NUMBER: ",
                           listArgv[index], NULL);
          ckfree((char *)listArgv);
          if (!quickFlag)
            ca_sg_delete(gid);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, " ", pch->tclValue.tclStr, " NOT A NUMBER: ",
                           listArgv[index], (char *)NULL);
          ckfree((char *)listArgv);
          if (!quickFlag)
            ca_sg_delete(gid);
          return (-1);
        }
      }

      if (status != ECA_NORMAL) {
        if (UseCatch) {
          Tcl_AppendResult(interp, "ca_put: ", listArgv[index], NULL);
          ckfree((char *)listArgv);
          if (!quickFlag)
            ca_sg_delete(gid);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "ca_put: ", listArgv[index], (char *)NULL);
          ckfree((char *)listArgv);
          if (!quickFlag)
            ca_sg_delete(gid);
          return (-1);
        }
      }
    }
    index++;
  } /* end while */

  if (waitFlag && !quickFlag) {
    status = ca_sg_block(gid, pendioTime);
    if (status != ECA_NORMAL) {
      ca_sg_delete(gid);
      if (UseCatch) {
        Tcl_SetResult(interp, "ca_sg_block:timeout", TCL_STATIC);
        ckfree((char *)listArgv);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "ca_sg_block:timeout", (char *)NULL);
        ckfree((char *)listArgv);
        return (-1);
      }
    }
    ca_sg_delete(gid);
  } else {
    status = ca_flush_io();
  }

  ckfree((char *)listArgv);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/******************************************
 * get(w) a pv  get...asynchronous, getw...synchronous
 *****************************************/
int tclCaGet(Tcl_Interp *interp, char *tclNameList,
             int waitFlag, float pendioTime, int UseCatch) {

  int status, error, notFoundFlag;
  int index, listArgc;
  char **listArgv;
  ITEM *pitem;
  CHANDATA *pchandata;
  Tcl_DString dsPtr;
  int getOverNetwork;

  if (Tcl_SplitList(interp, tclNameList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);
  getOverNetwork = False;

  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&dsPtr, listArgv[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  error = 0;
  index = 0;

  while (index < listArgc) {
    pitem = pv_exists(listArgv[index]);
    pchandata = pitem->pchandata;
    if (pchandata->castate == NeverConnected) {
      index++;
      continue;
    } else if (pchandata->castate == LostConnection) {
      index++;
      continue;
    } else if (!ca_read_access(pchandata->chid)) {
      pchandata->castate = ReadAccess;
      index++;
      continue;
    } else if (pchandata->evid != NULL) {
      index++;
      continue;
    } else if (!waitFlag) {
      status = ca_array_get_callback(
                                     dbf_type_to_DBR_TIME(ca_field_type(pchandata->chid)),
                                     ca_element_count(pchandata->chid),
                                     pchandata->chid,
                                     updateGetChPrep,
                                     (void *)pchandata);
      if (status != ECA_NORMAL) {
        if (UseCatch) {
          Tcl_AppendResult(interp, "CA:get_callback: ", listArgv[index], NULL);
          ckfree((char *)listArgv);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "CA:get_callback: ", listArgv[index],
                           (char *)NULL);
          ckfree((char *)listArgv);
          return (-1);
        }
      }
      pchandata->castate = PendIO;
      pchandata->countPendIO++;
    } else {
      status = ca_array_get(
                            dbf_type_to_DBR_TIME(ca_field_type(pchandata->chid)),
                            ca_element_count(pchandata->chid),
                            pchandata->chid,
                            (void *)pchandata->pdata);
      if (status != ECA_NORMAL) {
        if (UseCatch) {
          Tcl_AppendResult(interp, "CA:get_callback: ", listArgv[index], NULL);
          ckfree((char *)listArgv);
          return TCL_ERROR;
        } else {
          Tcl_SetErrorCode(interp, "CA:get_callback: ", listArgv[index],
                           (char *)NULL);
          ckfree((char *)listArgv);
          return (-1);
        }
      }
    }
    index++;

  } /* end while */

  if (!waitFlag) {
    status = ca_flush_io();
  } else {
    status = ca_pend_io(pendioTime);
    if (status != ECA_NORMAL) {
      ckfree((char *)listArgv);
      if (UseCatch) {
        Tcl_SetResult(interp, "ca:pend_io: ", TCL_STATIC);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "ca:pend_io: ", (char *)NULL);
        return (-1);
      }
    }
  }

  if (waitFlag) {
    index = 0;
    while (index < listArgc) {
      pitem = pv_exists(listArgv[index]);
      pchandata = pitem->pchandata;

      if (pchandata->evid != NULL ||
          pchandata->castate == NeverConnected ||
          !ca_read_access(pchandata->chid) ||
          pchandata->castate == LostConnection) {
        index++;
        continue;
      }

      copyCaTypeToTclType(pchandata);
#if defined(USE_BLT)
      copyNativeValuesToVector(pchandata);
#endif
      updateInterpVar(pchandata);
      index++;
    } /* end while */
  }
  ckfree((char *)listArgv);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/*******************************************************
 * .register a file descriptor with tcl
 * .becomes part of event loop after registration
 *   so that any input on fd will activate epicsFdMonitor
 *   which then processes the channel  IO
 *******************************************************/

void registerFD(void *dummy, int fd, int condition) {

#if defined(_WIN32)
  Tcl_Channel chan;
  /*chan = Tcl_MakeFileChannel(&fd,TCL_READABLE);*/
  chan = Tcl_MakeTcpClientChannel((ClientData)&fd);
  if (condition) {
    Tcl_CreateChannelHandler(chan, TCL_READABLE, epicsFdMonitor, NULL);
  } else {
    Tcl_DeleteChannelHandler(chan, epicsFdMonitor, NULL);
  }
#else
  if (condition) {
    Tcl_CreateFileHandler(fd, TCL_READABLE, epicsFdMonitor, NULL);
  } else {
    Tcl_DeleteFileHandler(fd);
  }
#endif
}

/*******************************************************
 * TK will call whenever fd gets input...see registerFD above
 *******************************************************/

void epicsFdMonitor(void *dummy, int mask) {
  ca_pend_event(MAGIC_POLL);
}

/*******************************************************
 *     vviewPort set the viewport for vectors
 *     determines base size & format of returned result/buffer update
 *     all ret data (from vview command) eventually comes from chandata buffers
 *         chandata buffers receive data via get(w)
 *     all incoming data (from vview command) is put in chandata buffer
 *         which gets sent via put(w)
 *******************************************************/
int tclCaVviewport(Tcl_Interp *interp, char *tclNameList, char *portParmList, int UseCatch) {

  CHANDATA *pch;
  ITEM *pitem;
  char **listArgvtcl;
  char **listArgvport;
  int index, listArgctcl, listArgcport, notFoundFlag;
  int base, size, precision, nelm;
  Tcl_DString dsPtr;

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList tclName: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList tclName: ", (char *)NULL);
      return (-1);
    }
  }
  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);

  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&dsPtr, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }
  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  if (Tcl_SplitList(interp, portParmList, &listArgcport, (CACONST char ***)&listArgvport) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "port:splitList : ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "port:splitList : ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }
  if (listArgcport > 0) {
    if (Tcl_GetInt(interp, listArgvport[0], &base) != TCL_OK) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "base not integer: ", listArgvport[0], NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "base not integer: ", listArgvport[0],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return (-1);
      }
    }
  } else {
    base = 0;
  }
  if (listArgcport > 1) {
    if (Tcl_GetInt(interp, listArgvport[1], &size) != TCL_OK) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "size not integer: ", listArgvport[1], NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "size not integer: ", listArgvport[1], (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return (-1);
      }
    }
  } else {
    size = 0;
  }
  if (listArgcport > 2) {
    if (Tcl_GetInt(interp, listArgvport[2], &precision) != TCL_OK) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "format not integer: ", listArgvport[2], NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "format not integer: ", listArgvport[2],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return (-1);
      }
    }
  } else {
    precision = 0;
  }

  index = 0;
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "FIRST NOT FOUND: ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "FIRST NOT FOUND: ", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvport);
        return (-1);
      }
    } else {
      pch = pitem->pchandata;
    }
    nelm = ca_element_count(pch->chid);
    if (base >= nelm) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "base too large: ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "base too large: ", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        return (-1);
      }
    }
    if (size == 0) {
      size = nelm - base;
    } else if ((base + size) > nelm) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "base + size >  nelm: ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "base + size >  nelm: ", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        return (-1);
      }
    }
    pch->view.base = base;
    pch->view.size = size;
    pch->view.precision = precision;
    index++;
  } /* end while */
  if (UseCatch) {
    return TCL_OK;
  } else {
    return 0;
  }
}

/*******************************************************
 *     vviewput put the viewport into vectors
 *	returns as result the vector viewport
 *******************************************************/
int tclCaVviewput(Tcl_Interp *interp, char *tclNameList, char *valueList, int UseCatch) {

  CHANDATA *pch;
  ITEM *pitem;
  char **listArgvtcl;
  char **listArgv;
  int index, listArgctcl, listArgc;
  int base, size, nelm, i;
  short *pshort;
  long *plong;
  float *pfloat;
  double *pdouble;
  unsigned char *pchar;
  Tcl_DString newList;
  DATABUF *pdata;
  int notFoundFlag;
  double dtemp;

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList tclName: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList tclName: ", (char *)NULL);
      return (-1);
    }
  }
  if (listArgctcl != 1) {
    if (UseCatch) {
      Tcl_SetResult(interp, "only one tcl variable allowed: ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "only one tcl variable allowed: ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&newList);

  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if ((pitem == NULL) || (pitem->pchandata->castate == NeverConnected)) {
      Tcl_DStringAppendElement(&newList, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED or NEVER CONNECTED ",
                       Tcl_DStringValue(&newList), NULL);
      Tcl_DStringFree(&newList);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED or NEVER CONNECTED",
                       Tcl_DStringValue(&newList), (char *)NULL);
      Tcl_DStringFree(&newList);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }
  Tcl_DStringFree(&newList);

  if (Tcl_SplitList(interp, valueList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList values: ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList values: ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }

  pitem = pv_exists(listArgvtcl[0]);
  pch = pitem->pchandata;
  pdata = pch->pdata;
  base = pch->view.base;
  size = pch->view.size;
  if (size > listArgc)
    size = listArgc;
  nelm = ca_element_count(pch->chid);
  if (base >= nelm) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "base too large: ", listArgvtcl[0], NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgv);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "base too large: ", listArgvtcl[0], (char *)NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgv);
      return (-1);
    }
  }
  if (base + size > nelm)
    size = nelm - base;

  switch (pch->iType) {
  case DBF_CHAR:
    pchar = &pdata->c.value;
    index = 0;
    for (i = base; i < base + size; i++) {
      Tcl_GetDouble(interp, listArgv[index], &dtemp);
      pchar[i] = dtemp;
      index++;
    }
    break;
  case DBF_INT:
    pshort = &pdata->i.value;
    index = 0;
    for (i = base; i < base + size; i++) {
      Tcl_GetDouble(interp, listArgv[index], &dtemp);
      pshort[i] = dtemp;
      index++;
    }
    break;
  case DBF_LONG:
    plong = (long *)&pdata->l.value;
    index = 0;
    for (i = base; i < base + size; i++) {
      Tcl_GetDouble(interp, listArgv[index], &dtemp);
      plong[i] = dtemp;
      index++;
    }
    break;
  case DBF_FLOAT:
    pfloat = &pdata->f.value;
    index = 0;
    for (i = base; i < base + size; i++) {
      Tcl_GetDouble(interp, listArgv[index], &dtemp);
      pfloat[i] = dtemp;
      index++;
    }
    break;
  case DBF_DOUBLE:
    pdouble = &pdata->d.value;
    index = 0;
    for (i = base; i < base + size; i++) {
      Tcl_GetDouble(interp, listArgv[index], &dtemp);
      pdouble[i] = dtemp;
      index++;
    }
    break;
  default:
    if (UseCatch) {
      Tcl_AppendResult(interp, "TYPE NOT SUPPORTED: ", listArgvtcl[0], NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgv);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "TYPE NOT SUPPORTED: ", listArgvtcl[0],
                       (char *)NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgv);
      return (-1);
    }
  }
  ckfree((char *)listArgvtcl);
  ckfree((char *)listArgv);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/*******************************************************
 *     vviewget get the viewport for vectors
 *	returns as result the vector viewport
 *******************************************************/
int tclCaVviewget(Tcl_Interp *interp, char *tclNameList, int UseCatch) {

  CHANDATA *pch;
  ITEM *pitem;
  char **listArgvtcl;
  int index, listArgctcl;
  int base, size, precision, nelm, i;
  short *pshort;
  long *plong;
  float *pfloat;
  double *pdouble;
  unsigned char *pchar;
  Tcl_DString newList;
  char pstr[40];
  DATABUF *pdata;
  int notFoundFlag;

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList tclName: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList tclName: ", (char *)NULL);
      return (-1);
    }
  };
  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&newList);

  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&newList, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&newList), NULL);
      Tcl_DStringFree(&newList);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&newList),
                       (char *)NULL);
      Tcl_DStringFree(&newList);
      return (-1);
    }
  }
  Tcl_DStringFree(&newList);

  Tcl_DStringInit(&newList);
  index = 0;

  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    pch = pitem->pchandata;
    if (pch->castate == NeverConnected) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "NEVER CONNECTED: ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "NEVER CONNECTED: ", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        return (-1);
      }
    }
    pdata = pch->pdata;
    base = pch->view.base;
    size = pch->view.size;
    precision = pch->view.precision;
    nelm = ca_element_count(pch->chid);
    if (base >= nelm) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "base too large: ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "base too large: ", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        return (-1);
      }
    }
    if (base + size > nelm)
      size = nelm - base;
    Tcl_DStringStartSublist(&newList);

    switch (pch->iType) {
    case DBF_CHAR:
      pchar = &pdata->c.value;
      for (i = base; i < base + size; i++) {
        sprintf(pstr, fmt[precision], (double)pchar[i]);
        Tcl_DStringAppendElement(&newList, pstr);
      }
      break;
    case DBF_INT:
      pshort = &pdata->i.value;
      for (i = base; i < base + size; i++) {
        sprintf(pstr, fmt[precision], (double)pshort[i]);
        Tcl_DStringAppendElement(&newList, pstr);
      }
      break;
    case DBF_LONG:
      plong = (long *)&pdata->l.value;
      for (i = base; i < base + size; i++) {
        sprintf(pstr, fmt[precision], (double)plong[i]);
        Tcl_DStringAppendElement(&newList, pstr);
      }
      break;
    case DBF_FLOAT:
      pfloat = &pdata->f.value;
      for (i = base; i < base + size; i++) {
        sprintf(pstr, fmt[precision], (double)pfloat[i]);
        Tcl_DStringAppendElement(&newList, pstr);
      }
      break;
    case DBF_DOUBLE:
      pdouble = &pdata->d.value;
      for (i = base; i < base + size; i++) {
        sprintf(pstr, fmt[precision], (double)pdouble[i]);
        Tcl_DStringAppendElement(&newList, pstr);
      }
      break;
    default:
      Tcl_DStringAppendElement(&newList, "TYPE UNSUPPORTED");
    }
    Tcl_DStringEndSublist(&newList);
    index++;
  } /* end while */
  Tcl_DStringResult(interp, &newList);
  Tcl_DStringFree(&newList);
  ckfree((char *)listArgvtcl);

  if (UseCatch) {
    return TCL_OK;
  } else {
    return 0;
  }
}

#if defined(USE_BLT)
/******************************************
 * link a multi-element tvl var to a blt vector
 *****************************************/
int tclCaVmapToVector(Tcl_Interp *interp, char *tclNameList, char *bltNameList, int UseCatch) {

  Tcl_DString dsPtr;
  ITEM *pitem;
  int index, notFoundFlag, nelm;
  CHANDATA *pch;
  int listArgctcl, listArgcblt;
  char **listArgvtcl;
  char **listArgvblt;

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, &listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList: ", (char *)NULL);
      return (-1);
    }
  }
  if (Tcl_SplitList(interp, bltNameList, &listArgcblt, &listArgvblt) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "vector:splitList: ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "vector:splitList: ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }
  if (listArgctcl != listArgcblt) {
    if (UseCatch) {
      Tcl_SetResult(interp, "List size mismatch", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "List size mismatch", (char *)NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&dsPtr, listArgvtcl[index]);
      notFoundFlag++;
    } else if (pitem->pchandata->castate == NeverConnected) {
      Tcl_DStringAppendElement(&dsPtr, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED OR NEVER CONNECTED ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED OR NEVER CONNECTED", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    nelm = ca_element_count(pitem->pchandata->chid);
    if (nelm == 1 || pitem->pchandata->iType == DBF_ENUM || pitem->pchandata->iType == DBF_STRING) {
      Tcl_DStringAppendElement(&dsPtr, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "UNSUPPORTED VECTOR TYPE ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "UNSUPPORTED VECTOR TYPE", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&dsPtr);
  while (index < listArgctcl) {
    if (Blt_VectorExists(interp, listArgvblt[index])) {
      Tcl_DStringAppendElement(&dsPtr, listArgvblt[index]);
      notFoundFlag++;
    }
    index++;
  }

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "VECTOR EXISTS ", Tcl_DStringValue(&dsPtr), NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "VECTOR EXISTS", Tcl_DStringValue(&dsPtr),
                       (char *)NULL);
      Tcl_DStringFree(&dsPtr);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgvblt);
      return (-1);
    }
  }
  Tcl_DStringFree(&dsPtr);

  /* It is always possible to delete a vector by name
     in the TCL script so must be careful in handling */
  index = 0;
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    pch = pitem->pchandata;
    if (pitem->vecname != NULL && Blt_VectorExists(interp, pitem->vecname)) {
      Blt_DeleteVectorByName(interp, pitem->vecname);
    }
    if (pitem->vecname != NULL) {
      free(pitem->vecname);
      free(pch->pvec);
      pitem->vecname = NULL;
    }
    pitem->vecname = (char *)malloc(strlen(listArgvblt[index]) + 1);
    strcpy(pitem->vecname, listArgvblt[index]);
    pch->pvec = (double *)calloc(nelm, sizeof(double));
    if (pch->pvec == NULL) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "pv ", "CAN'T ALLOCATE MEMORY FOR VECTOR ", listArgvtcl[index], NULL);
        free(pitem->vecname);
        pitem->vecname = NULL;
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvblt);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "pv", "CAN'T ALLOCATE MEMORY FOR VECTOR", listArgvtcl[index],
                         (char *)NULL);
        free(pitem->vecname);
        pitem->vecname = NULL;
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvblt);
        return (-1);
      }
    }
    if (Blt_CreateVector(interp, listArgvblt[index], 0, &(pch->vecPtr)) != TCL_OK) {
      if (UseCatch) {
        Tcl_AppendResult(interp, "pv ", "CAN'T CREATE VECTOR ", listArgvtcl[index], NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvblt);
        return TCL_ERROR;
      } else {
        Tcl_SetErrorCode(interp, "pv", "CAN'T CREATE VECTOR", listArgvtcl[index],
                         (char *)NULL);
        ckfree((char *)listArgvtcl);
        ckfree((char *)listArgvblt);
        return (-1);
      }
    }
    copyNativeValuesToVector(pch);
    index++;
  }
  ckfree((char *)listArgvtcl);
  ckfree((char *)listArgvblt);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/*******************************************************
 * Copy native  values to vector of doubles pointed to by pvec.
pv get d *******************************************************/
void copyVectorValuesToNative(CHANDATA *pch) {
  short *pshort;
  long *plong;
  float *pfloat;
  double *pdouble;
  unsigned char *pchar;
  int i, nelm, vecLength;
  double *pvec;
  Blt_Vector *vecPtr;
  DATABUF *pdata = pch->pdata;

  if (pch->pitem->vecname == NULL)
    return;
  if (!Blt_VectorExists(pch->interp, pch->pitem->vecname))
    return;
  Blt_GetVector(pch->interp, pch->pitem->vecname, &vecPtr);
  nelm = ca_element_count(pch->chid);
  vecLength = nelm < vecPtr->numValues ? nelm : vecPtr->numValues;
  pvec = vecPtr->valueArr;

  switch (pch->iType) {
  case DBF_CHAR:
    pchar = &pdata->c.value;
    for (i = 0; i < vecLength; i++) {
      pchar[i] = (char)pvec[i];
    }
    break;
  case DBF_INT:
    pshort = &pdata->i.value;
    for (i = 0; i < vecLength; i++) {
      pshort[i] = (short)pvec[i];
    }
    break;
  case DBF_LONG:
    plong = (long *)&pdata->l.value;
    for (i = 0; i < vecLength; i++) {
      plong[i] = (long)pvec[i];
    }
    break;
  case DBF_FLOAT:
    pfloat = &pdata->f.value;
    for (i = 0; i < vecLength; i++) {
      pfloat[i] = (float)pvec[i];
    }
    break;
  case DBF_DOUBLE:
    pdouble = &pdata->d.value;
    for (i = 0; i < vecLength; i++) {
      pdouble[i] = pvec[i];
    }
    break;
  default:
    return;
  }
  copyCaTypeToTclType(pch);
}

/*******************************************************
 * Copy native  values to vector of doubles pointed to by pvec.
 *******************************************************/
void copyNativeValuesToVector(CHANDATA *pch) {
  short *pshort;
  long *plong;
  float *pfloat;
  double *pdouble;
  unsigned char *pchar;
  int i, nelm;
  double *pvec = pch->pvec;
  DATABUF *pdata = pch->pdata;

  if (ca_element_count(pch->chid) == 1)
    return;
  if (pch->pitem->vecname == NULL) {
    return;
  }

  if (!Blt_VectorExists(pch->interp, pch->pitem->vecname)) {
    return;
  }

  nelm = ca_element_count(pch->chid);
  switch (pch->iType) {
  case DBF_CHAR:
    pchar = &pdata->c.value;
    for (i = 0; i < nelm; i++) {
      pvec[i] = (double)pchar[i];
    }
    break;
  case DBF_INT:
    pshort = &pdata->i.value;
    for (i = 0; i < nelm; i++) {
      pvec[i] = (double)pshort[i];
    }
    break;
  case DBF_LONG:
    plong = (long *)&pdata->l.value;
    for (i = 0; i < nelm; i++) {
      pvec[i] = (double)plong[i];
    }
    break;
  case DBF_FLOAT:
    pfloat = &pdata->f.value;
    for (i = 0; i < nelm; i++) {
      pvec[i] = (double)pfloat[i];
    }
    break;
  case DBF_DOUBLE:
    pdouble = &pdata->d.value;
    for (i = 0; i < nelm; i++) {
      pvec[i] = (double)pdouble[i];
    }
    break;
  default:
    return;
  }
  Blt_ResetVector(pch->vecPtr, pch->pvec, nelm, nelm, TCL_STATIC);
  return;
}
#endif

/*******************************************************
 * INFO  state returns status of ca connection
 *       user should check after each link(w),put(w) or get(w)
 *       in async mode only way to check for IO completion
 *******************************************************/
int tclCaInfostate(Tcl_Interp *interp, char *tclNameList, char *pvParmList, int UseCatch) {

  int parm;
  DATABUF *pd;
  INFOBUF *ib;
  int index, index2, listArgc, listArgcp;
  char **listArgv;
  char **listArgvp;
  ITEM *pitem;
  CHANDATA *pchandata;
  Tcl_DString newList, choiceList;
  int choiceFlag, i;
  char tsText[40];
  const char *pstr;
  int swParm;

  parm = 1;

  if (Tcl_SplitList(interp, tclNameList, &listArgc, (CACONST char ***)&listArgv) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList tclName: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList tclName: ", (char *)NULL);
      return (-1);
    }
  }
  if (Tcl_SplitList(interp, pvParmList, &listArgcp, (CACONST char ***)&listArgvp) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList pvParm: ", TCL_STATIC);
      ckfree((char *)listArgv);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList pvParm: ", (char *)NULL);
      ckfree((char *)listArgv);
      return (-1);
    }
  }
  Tcl_DStringInit(&newList);
  index = 0;

  while (index < listArgc) {
    index2 = 0;
    Tcl_DStringStartSublist(&newList);
    Tcl_DStringAppendElement(&newList, listArgv[index]);
    pitem = pv_exists(listArgv[index]);
    if (pitem == NULL) {
      while (index2 < listArgcp) {
        Tcl_DStringAppendElement(&newList, "__");
        index2++;
      }
      Tcl_DStringEndSublist(&newList);
    } else {
      pchandata = pitem->pchandata;
      pd = pchandata->pdata;
      ib = pchandata->info;
      if (pchandata->castate <= ReadAccess) {
        swParm = 666;
      } else {
        swParm = pchandata->iType;
      }
      choiceFlag = False;
      switch (swParm) {
      case 666:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_STRING:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->s.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->s.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->s.stamp);
            pstr = tsText;
            /*pstr = tsStampToText(&pd->s.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_ENUM:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->e.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->e.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->e.stamp);
            pstr = tsText;
            /*pstr = tsStampToText(&pd->e.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "choices") == 0) {
            Tcl_DStringInit(&choiceList);
            for (i = 0; i < ib->e.no_str; i++) {
              /*if(i != 0) Tcl_DStringAppen(&choiceList," ",-1);*/
              Tcl_DStringAppendElement(&choiceList, ib->e.strs[i]);
            }
            pstr = Tcl_DStringValue(&choiceList);
            choiceFlag = True;
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          if (choiceFlag == True) {
            choiceFlag = False;
            Tcl_DStringFree(&choiceList);
          }

          index2++;
        }
        break;
      case DBF_CHAR:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->c.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->c.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->c.stamp);
            pstr = tsText;
            /* pstr = tsStampToText(&pd->c.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "units") == 0) {
            pstr = ib->c.units;
          } else if (strcmp(listArgvp[index2], "hopr") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.upper_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lopr") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.lower_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvh") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.upper_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvl") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.lower_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hihi") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.upper_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hi") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.upper_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lolo") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.lower_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lo") == 0) {
            sprintf(tsText, "%u", (unsigned int)ib->c.lower_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_SHORT:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->i.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->i.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->i.stamp);
            pstr = tsText;
            /* pstr = tsStampToText(&pd->i.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "units") == 0) {
            pstr = ib->i.units;
          } else if (strcmp(listArgvp[index2], "hopr") == 0) {
            sprintf(tsText, "%d", (int)ib->i.upper_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lopr") == 0) {
            sprintf(tsText, "%d", (int)ib->i.lower_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvh") == 0) {
            sprintf(tsText, "%d", (int)ib->i.upper_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvl") == 0) {
            sprintf(tsText, "%d", (int)ib->i.lower_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hihi") == 0) {
            sprintf(tsText, "%d", (int)ib->i.upper_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hi") == 0) {
            sprintf(tsText, "%d", (int)ib->i.upper_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lolo") == 0) {
            sprintf(tsText, "%d", (int)ib->i.lower_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lo") == 0) {
            sprintf(tsText, "%d", (int)ib->i.lower_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_LONG:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->l.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->l.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->l.stamp);
            pstr = tsText;
            /* pstr = tsStampToText(&pd->l.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "units") == 0) {
            pstr = ib->l.units;
          } else if (strcmp(listArgvp[index2], "hopr") == 0) {
            sprintf(tsText, "%d", ib->l.upper_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lopr") == 0) {
            sprintf(tsText, "%d", ib->l.lower_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvh") == 0) {
            sprintf(tsText, "%d", ib->l.upper_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvl") == 0) {
            sprintf(tsText, "%d", ib->l.lower_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hihi") == 0) {
            sprintf(tsText, "%d", ib->l.upper_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hi") == 0) {
            sprintf(tsText, "%d", ib->l.upper_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lolo") == 0) {
            sprintf(tsText, "%d", ib->l.lower_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lo") == 0) {
            sprintf(tsText, "%d", ib->l.lower_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_FLOAT:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->f.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->f.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->f.stamp);
            pstr = tsText;
            /*pstr = tsStampToText(&pd->f.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "units") == 0) {
            pstr = ib->f.units;
          } else if (strcmp(listArgvp[index2], "precision") == 0) {
            sprintf(tsText, "%hd", ib->f.precision);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hopr") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.upper_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lopr") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.lower_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvh") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.upper_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvl") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.lower_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hihi") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.upper_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hi") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.upper_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lolo") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.lower_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lo") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    (double)ib->f.lower_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      case DBF_DOUBLE:
        while (index2 < listArgcp) {
          if (strcmp(listArgvp[index2], "state") == 0) {
            pstr = ss[pchandata->castate];
          } else if (strcmp(listArgvp[index2], "status") == 0) {
            pstr = alarmStatusString[pd->d.status];
          } else if (strcmp(listArgvp[index2], "severity") == 0) {
            pstr = alarmSeverityString[pd->d.severity];
          } else if (strcmp(listArgvp[index2], "time") == 0) {
            epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->d.stamp);
            pstr = tsText;
            /* pstr = tsStampToText(&pd->d.stamp,TS_TEXT_MMDDYY,tsText);*/
          } else if (strcmp(listArgvp[index2], "units") == 0) {
            pstr = ib->d.units;
          } else if (strcmp(listArgvp[index2], "precision") == 0) {
            sprintf(tsText, "%hd", ib->d.precision);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hopr") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.upper_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lopr") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.lower_disp_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvh") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.upper_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "drvl") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.lower_ctrl_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hihi") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.upper_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "hi") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.upper_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lolo") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.lower_alarm_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "lo") == 0) {
            sprintf(tsText, fmt[pchandata->view.precision],
                    ib->d.lower_warning_limit);
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "name") == 0) {
            pstr = ca_name(pchandata->chid);
          } else if (strcmp(listArgvp[index2], "size") == 0) {
            sprintf(tsText, "%lu", ca_element_count(pchandata->chid));
            pstr = tsText;
          } else if (strcmp(listArgvp[index2], "access") == 0) {
            if (ca_write_access(pchandata->chid))
              pstr = "RW";
            else if (ca_read_access(pchandata->chid))
              pstr = "R";
            else
              pstr = "NO";
          } else if (strcmp(listArgvp[index2], "ioc") == 0) {
            pstr = ca_host_name(pchandata->chid);
          } else {
            pstr = "__";
          }
          Tcl_DStringAppendElement(&newList, (char *)pstr);
          index2++;
        }
        break;
      default:
        pstr = "UNKNOWN TYPE";
        Tcl_DStringAppendElement(&newList, (char *)pstr);
        index2++;
      }
      Tcl_DStringEndSublist(&newList);
    }
    index++;
  }
  Tcl_DStringResult(interp, &newList);
  Tcl_DStringFree(&newList);
  ckfree((char *)listArgv);
  ckfree((char *)listArgvp);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return (0);
  }
}

/*******************************************************
 * STAT   returns assocaitive array of
 *       status,severity, and time
 *       returned with every get & put
 *       and state
 *******************************************************/
int tclCaStat(Tcl_Interp *interp, char *tclNameList, char *arrayList, int UseCatch) {

  DATABUF *pd;
  int index, listArgctcl, listArgca;
  char **listArgvtcl;
  char **listArgva;
  ITEM *pitem;
  CHANDATA *pch;
  Tcl_DString newList;
  int notFoundFlag;
  char tsText[40];
  char *pstrState;
  char *pstrStatus;
  char *pstrSeverity;
  char *pstrTime;
  char *pvarVal;

  if (Tcl_SplitList(interp, tclNameList, &listArgctcl, (CACONST char ***)&listArgvtcl) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList tclName: ", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList tclName: ", (char *)NULL);
      return (-1);
    }
  }

  index = 0;
  notFoundFlag = 0;
  Tcl_DStringInit(&newList);

  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    if (pitem == NULL) {
      Tcl_DStringAppendElement(&newList, listArgvtcl[index]);
      notFoundFlag++;
    }
    index++;
  }
  Tcl_DStringFree(&newList);

  if (notFoundFlag > 0) {
    if (UseCatch) {
      Tcl_AppendResult(interp, "pv ", "NOT LINKED ", Tcl_DStringValue(&newList), NULL);
      Tcl_DStringFree(&newList);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "pv", "NOT LINKED", Tcl_DStringValue(&newList),
                       (char *)NULL);
      Tcl_DStringFree(&newList);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }

  if (Tcl_SplitList(interp, arrayList, &listArgca, (CACONST char ***)&listArgva) != TCL_OK) {
    if (UseCatch) {
      Tcl_SetResult(interp, "tcl:splitList array: ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "tcl:splitList array: ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      return (-1);
    }
  }
  if (listArgctcl != listArgca) {
    if (UseCatch) {
      Tcl_SetResult(interp, "stat: unequal length lists: ", TCL_STATIC);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgva);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, "stat: unequal length lists: ", (char *)NULL);
      ckfree((char *)listArgvtcl);
      ckfree((char *)listArgva);
      return (-1);
    }
  }
  index = 0;
  while (index < listArgctcl) {
    pitem = pv_exists(listArgvtcl[index]);
    pch = pitem->pchandata;
    pd = pch->pdata;
    if (pch->castate <= ReadAccess) {
      pstrState = "__";
      pstrStatus = "__";
      pstrSeverity = "__";
      pstrTime = "__";
    } else {
      pstrState = ss[pch->castate];
      pstrStatus = (char *)alarmStatusString[pd->d.status];
      pstrSeverity = (char *)alarmSeverityString[pd->d.severity];
      epicsTimeToStrftime(tsText, 28, "%m/%d/%y %H:%M:%S.%09f", &pd->d.stamp);
      pstrTime = tsText;
      /*pstrTime = tsStampToText(&pd->d.stamp,TS_TEXT_MMDDYY,tsText);*/
    }
    pvarVal = (char *)Tcl_SetVar2(interp, listArgva[index], "status", pstrStatus,
                                  TCL_GLOBAL_ONLY);
    pvarVal = (char *)Tcl_SetVar2(interp, listArgva[index], "severity", pstrSeverity,
                                  TCL_GLOBAL_ONLY);
    pvarVal = (char *)Tcl_SetVar2(interp, listArgva[index], "state", pstrState,
                                  TCL_GLOBAL_ONLY);
    pvarVal = (char *)Tcl_SetVar2(interp, listArgva[index], "time", pstrTime,
                                  TCL_GLOBAL_ONLY);
    index++;
  }
  ckfree((char *)listArgvtcl);
  ckfree((char *)listArgva);
  if (UseCatch) {
    return TCL_OK;
  } else {
    return 0;
  }
}
/*
 *----------------------------------------------------------------------
 *
 * pendRecycleProc --
 *
 *	This procedure is invoked once every .1sec
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A new timer callback is created to call us again in another
 *	5 seconds
 *----------------------------------------------------------------------
 */

static void pendRecycleProc(ClientData clientData) {
  /* NOTE: changed original .001 to 1e-9. A "magic number" timeout which
     is less than 1e-6 results in a poll. Anything greater waits.
  */
  ca_pend_event(MAGIC_POLL);
#if defined(_WIN32)
  Tcl_CreateTimerHandler(100, pendRecycleProc, (ClientData)NULL);
#else
  Tcl_CreateTimerHandler(5000, pendRecycleProc, (ClientData)NULL);
#endif
}
