/*
 * Interface to Postgres 2.0
 *
 * $Header: RCS/pg-libpq.c,v 1.2 91/03/08 13:22:28 kemnitz Exp $
 *
 * Tue Aug 21 14:13:40 1990  Igor Metz <metz@iam.unibe.ch>
 *
 * $Id: pg-libpq.c,v 1.2 91/03/08 13:22:28 kemnitz Exp $
 * $Log:	pg-libpq.c,v $
 * Revision 1.2  91/03/08  13:22:28  kemnitz
 * added RCS header.
 * 
 * Revision 1.1  90/10/24  20:31:09  cimarron
 * Initial revision
 * 
Revision 1.1  90/08/23  15:18:20  metz
Initial revision

 * 
 */

#include "tmp/libpq.h"

#include "EXTERN.h"
#include "pg-perl.h"

static enum uservars {
  UV_PQhost,
  UV_PQport,
  UV_PQtty,
  UV_PQoption,
  UV_PQdatabase,
  UV_PQportset,
  UV_PQxactid,
  UV_PQinitstr,
  UV_PQtracep
};

static enum usersubs {
  US_addPortal,
  US_addGroup,
  US_addTypes,
  US_addTuples,
  US_addTuple,
  US_addValues,
  US_addPortalEntry,
  US_freePortalEntry,
  US_freePortal,
  US_portal_setup,
  US_portal_close,
  US_InitVacuumDemon,
  US_PQnportals,
  US_PQpnames,
  US_PQparray,
  US_PQrulep,
  US_PQntuples,
  US_PQngroups,
  US_PQntuplesGroup,
  US_PQnfieldsGroup,
  US_PQfnumberGroup,
  US_PQfnameGroup,
  US_PQnfields,
  US_PQfnumber,
  US_PQfname,
  US_PQftype,
  US_PQsametype,
  US_PQgetgroup,
  US_PQgetvalue,
  US_PQdb,
  US_PQsetdb,
  US_PQreset,
  US_PQfinish,
  US_PQtrace,
  US_PQuntrace,
  US_pqdebug,
  US_pqdebug2,
  US_read_initstr,
  US_process_portal,
  US_read_remark,
  US_PQfn,
  US_PQexec 
};

static
unsigned int
dbl2uint(d)
     double d;
{
  unsigned int i = d;
  return i;
}

static
double
uint2dbl(i)
     unsigned int i;
{
  double d = i;
  return d;
}


static int usersub();
static int userset();
static int userval();

extern void
init_postgres_stuff()
{	
  struct ufuncs uf;
  char *filename = "libpq.c";

  uf.uf_set = userset;
  uf.uf_val = userval;

#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)

  /* register PG variables */
  MAGICVAR("PQhost",		UV_PQhost);
  MAGICVAR("PQport",		UV_PQport);
  MAGICVAR("PQtty",		UV_PQtty);
  MAGICVAR("PQoption",		UV_PQoption);
  MAGICVAR("PQdatabase",	UV_PQdatabase);
  MAGICVAR("PQportset",		UV_PQportset);
  MAGICVAR("PQxactid",		UV_PQxactid);
  MAGICVAR("PQinitstr",		UV_PQinitstr);
  MAGICVAR("PQtracep",		UV_PQtracep);

  /* register PG functions */
  make_usub("InitVacuumDemon",	US_InitVacuumDemon ,	usersub, filename);
  make_usub("PQdb",		US_PQdb,		usersub, filename);
  make_usub("PQexec",		US_PQexec ,		usersub, filename);
  make_usub("PQfinish",		US_PQfinish ,		usersub, filename);
  make_usub("PQfn",		US_PQfn ,		usersub, filename);
  make_usub("PQfname",		US_PQfname,		usersub, filename);
  make_usub("PQfnameGroup",	US_PQfnameGroup,	usersub, filename);
  make_usub("PQfnumber",	US_PQfnumber,		usersub, filename);
  make_usub("PQfnumberGroup",	US_PQfnumberGroup,	usersub, filename);
  make_usub("PQftype",		US_PQftype,		usersub, filename);
  make_usub("PQgetgroup",	US_PQgetgroup,		usersub, filename);
  make_usub("PQgetvalue",	US_PQgetvalue,		usersub, filename);
  make_usub("PQnfields",	US_PQnfields,		usersub, filename);
  make_usub("PQnfieldsGroup",	US_PQnfieldsGroup,	usersub, filename);
  make_usub("PQngroups",	US_PQngroups,		usersub, filename);
  make_usub("PQnportals",	US_PQnportals,		usersub, filename);
  make_usub("PQntuples",	US_PQntuples,		usersub, filename);
  make_usub("PQntuplesGroup",	US_PQntuplesGroup,	usersub, filename);
  make_usub("PQparray",		US_PQparray,		usersub, filename);
  make_usub("PQpnames",		US_PQpnames,		usersub, filename);
  make_usub("PQreset",		US_PQreset ,		usersub, filename);
  make_usub("PQrulep",		US_PQrulep,		usersub, filename);
  make_usub("PQsametype",	US_PQsametype,		usersub, filename);
  make_usub("PQsetdb",		US_PQsetdb ,		usersub, filename);
  make_usub("PQtrace",		US_PQtrace ,		usersub, filename);
  make_usub("PQuntrace",	US_PQuntrace ,		usersub, filename);
  make_usub("addGroup",		US_addGroup,		usersub, filename);
  make_usub("addPortal",	US_addPortal,		usersub, filename);
  make_usub("addPortalEntry",	US_addPortalEntry,	usersub, filename);
  make_usub("addTuple",		US_addTuple,		usersub, filename);
  make_usub("addTuples",	US_addTuples,		usersub, filename);
  make_usub("addTypes",		US_addTypes,		usersub, filename);
  make_usub("addValues",	US_addValues,		usersub, filename);
  make_usub("freePortal",	US_freePortal,		usersub, filename);
  make_usub("freePortalEntry",	US_freePortalEntry,	usersub, filename);
  make_usub("portal_close",	US_portal_close,	usersub, filename);
  make_usub("portal_setup",	US_portal_setup,	usersub, filename);
  make_usub("pqdebug",		US_pqdebug ,		usersub, filename);
  make_usub("pqdebug2",		US_pqdebug2 ,		usersub, filename);
  make_usub("process_portal",	US_process_portal ,	usersub, filename);
  make_usub("read_initstr",	US_read_initstr ,	usersub, filename);
  make_usub("read_remark",	US_read_remark ,	usersub, filename);
}

static int
usersub(ix, sp, items)
     int ix;
     register int sp;
     register int items;
{
  STR **st = stack->ary_array + sp;
  register int i;
  register char *tmps;
  register STR *Str;		/* used in str_get and str_gnum macros */

  switch (ix) {
/* Allocate a new portal buffer. */
    case US_addPortal:
	if (items != 0)
	    fatal("Usage: &addPortal()");
	else {
	    PortalBuffer* retval;

	    retval = addPortal();
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Add a new tuple group to the portal. */
    case US_addGroup:
	if (items != 1)
	    fatal("Usage: &addGroup($portal)");
	else {
	    GroupBuffer* retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));

	    retval = addGroup(portal);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Allocate n type blocks. */
    case US_addTypes:
	if (items != 1)
	    fatal("Usage: &addTypes($n)");
	else {
	    TypeBlock* retval;
	    int		n =	 (int	) dbl2uint(str_gnum(st[1]));

	    retval = addTypes(n);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Allocate a tuple block. */
    case US_addTuples:
	if (items != 0)
	    fatal("Usage: &addTuples()");
	else {
	    TupleBlock* retval;

	    retval = addTuples();
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Allocate a tuple of n fields (attributes). */
    case US_addTuple:
	if (items != 1)
	    fatal("Usage: &addTuple($n)");
	else {
	    char** retval;
	    int		n =	 (int	) dbl2uint(str_gnum(st[1]));

	    retval = addTuple(n);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Allocate n bytes for a value. */
    case US_addValues:
	if (items != 1)
	    fatal("Usage: &addValues($n)");
	else {
	    char* retval;
	    int		n =	 (int	) dbl2uint(str_gnum(st[1]));

	    retval = addValues(n);
	    str_set(st[0], retval);
	}
	return sp;

/* Allocate a portal entry. */
    case US_addPortalEntry:
	if (items != 0)
	    fatal("Usage: &addPortalEntry()");
	else {
	    PortalEntry* retval;

	    retval = addPortalEntry();
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Free a portal entry in the portal table, the portal is freed separately. */
    case US_freePortalEntry:
	if (items != 1)
	    fatal("Usage: &freePortalEntry($i)");
	else {
	    /* int retval = 1; */
	    int		i =	 (int	) dbl2uint(str_gnum(st[1]));

	    (void)freePortalEntry(i);
	    str_numset(st[0], 1.0);
	}
	return sp;

    case US_freePortal:
	if (items != 1)
	    fatal("Usage: &freePortal($portal)");
	else {
	    /* int retval = 1; */
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));

	    (void)freePortal(portal);
	    str_numset(st[0], 1.0);
	}
	return sp;

/* Set up a portal for dumping data. */
    case US_portal_setup:
	if (items != 1)
	    fatal("Usage: &portal_setup($pname)");
	else {
	    PortalBuffer* retval;
	    char*	pname =		str_get(st[1]);

	    retval = portal_setup(pname);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Close a portal, remove it from the portal table and free up the space. */
    case US_portal_close:
	if (items != 1)
	    fatal("Usage: &portal_close($pname)");
	else {
	    /* int retval = 1; */
	    char*	pname =		str_get(st[1]);

	    (void)portal_close(pname);
	    str_numset(st[0], 1.0);
	}
	return sp;

/* 
 * Return the number of open portals. 
 * If rule_p, only return asynchronized portals. 
 */
    case US_PQnportals:
	if (items != 1)
	    fatal("Usage: &PQnportals($rule_p)");
	else {
	    int retval;
	    int		rule_p = (int	) dbl2uint(str_gnum(st[1]));

	    retval = PQnportals(rule_p);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* 
 * Return all the portal names.
 * If rule_p, only return asynchronized portals. 
 */
    case US_PQpnames:
	if (items != 2)
	    fatal("Usage: &PQpnames($pnames, $rule_p)");
	else {
	    /* int retval = 1; */
	    char**	pnames = (char**) dbl2uint(str_gnum(st[1]));
	    int		rule_p = (int	) dbl2uint(str_gnum(st[2]));

	    (void)PQpnames(pnames, rule_p);
	    str_numset(st[0], 1.0);
	}
	return sp;

/* Return the portal buffer given a portal name. */
    case US_PQparray:
	if (items != 1)
	    fatal("Usage: &PQparray($pname)");
	else {
	    PortalBuffer* retval;
	    char*	pname =		str_get(st[1]);

	    retval = PQparray(pname);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return 1 if an asynchronized portal. */
    case US_PQrulep:
	if (items != 1)
	    fatal("Usage: &PQrulep($portal)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));

	    retval = PQrulep(portal);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the number of tuples in a portal buffer. */
    case US_PQntuples:
	if (items != 1)
	    fatal("Usage: &PQntuples($portal)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));

	    retval = PQntuples(portal);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the number of tuple groups in a portal buffer. */
    case US_PQngroups:
	if (items != 1)
	    fatal("Usage: &PQngroups($portal)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));

	    retval = PQngroups(portal);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the number of tuples in a tuple group. */
    case US_PQntuplesGroup:
	if (items != 2)
	    fatal("Usage: &PQntuplesGroup($portal, $group_index)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		group_index = (int	) dbl2uint(str_gnum(st[2]));

	    retval = PQntuplesGroup(portal, group_index);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the number of fields in a tuple group. */
    case US_PQnfieldsGroup:
	if (items != 2)
	    fatal("Usage: &PQnfieldsGroup($portal, $group_index)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		group_index = (int	) dbl2uint(str_gnum(st[2]));

	    retval = PQnfieldsGroup(portal, group_index);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the field number (index) given the group index and the field name. */
    case US_PQfnumberGroup:
	if (items != 3)
	    fatal("Usage: &PQfnumberGroup($portal, $group_index, $field_name)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		group_index = (int	) dbl2uint(str_gnum(st[2]));
	    char*	field_name =	str_get(st[3]);

	    retval = PQfnumberGroup(portal, group_index, field_name);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the field (attribute) name given the group index and field index. */
    case US_PQfnameGroup:
	if (items != 3)
	    fatal("Usage: &PQfnameGroup($portal, $group_index, $field_number)");
	else {
	    char* retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		group_index = (int	) dbl2uint(str_gnum(st[2]));
	    int		field_number = (int	) dbl2uint(str_gnum(st[3]));

	    retval = PQfnameGroup(portal, group_index, field_number);
	    str_set(st[0], retval);
	}
	return sp;

/* Return the number of fields in a tuple. */
    case US_PQnfields:
	if (items != 2)
	    fatal("Usage: &PQnfields($portal, $tuple_index)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));

	    retval = PQnfields(portal, tuple_index);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the field index of a given field name within a tuple. */
    case US_PQfnumber:
	if (items != 3)
	    fatal("Usage: &PQfnumber($portal, $tuple_index, $field_name)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));
	    char*	field_name =	str_get(st[3]);

	    retval = PQfnumber(portal, tuple_index, field_name);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return the name of a field. */
    case US_PQfname:
	if (items != 3)
	    fatal("Usage: &PQfname($portal, $tuple_index, $field_number)");
	else {
	    char* retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));
	    int		field_number = (int	) dbl2uint(str_gnum(st[3]));

	    retval = PQfname(portal, tuple_index, field_number);
	    str_set(st[0], retval);
	}
	return sp;

/* Return the type of a field. */
    case US_PQftype:
	if (items != 3)
	    fatal("Usage: &PQftype($portal, $tuple_index, $field_number)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));
	    int		field_number = (int	) dbl2uint(str_gnum(st[3]));

	    retval = PQftype(portal, tuple_index, field_number);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return 1 if the two tuples have the same type (in the same group). */
    case US_PQsametype:
	if (items != 3)
	    fatal("Usage: &PQsametype($portal, $tuple_index1, $tuple_index2)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index1 = (int	) dbl2uint(str_gnum(st[2]));
	    int		tuple_index2 = (int	) dbl2uint(str_gnum(st[3]));

	    retval = PQsametype(portal, tuple_index1, tuple_index2);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

    case US_PQgetgroup:
	if (items != 2)
	    fatal("Usage: &PQgetgroup($portal, $tuple_index)");
	else {
	    int retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));

	    retval = PQgetgroup(portal, tuple_index);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/* Return an attribute (field) value. */
    case US_PQgetvalue:
	if (items != 3)
	    fatal("Usage: &PQgetvalue($portal, $tuple_index, $field_number)");
	else {
	    char* retval;
	    PortalBuffer*	portal = (PortalBuffer*) dbl2uint(str_gnum(st[1]));
	    int		tuple_index = (int	) dbl2uint(str_gnum(st[2]));
	    int		field_number = (int	) dbl2uint(str_gnum(st[3]));

	    retval = PQgetvalue(portal, tuple_index, field_number);
	    str_set(st[0], retval);
	}
	return sp;

/* Return the current database being accessed. */
    case US_PQdb:
	if (items != 0)
	    fatal("Usage: &PQdb()");
	else {
	    char* retval;

	    retval = PQdb();
	    str_set(st[0], retval);
	}
	return sp;

/* Make the specified database the current database. */
    case US_PQsetdb:
	if (items != 1)
	    fatal("Usage: &PQsetdb($dbname)");
	else {
	    /* int retval = 1; */
	    char*	dbname =	str_get(st[1]);

	    (void)PQsetdb(dbname);
	    str_numset(st[0], 1.0);
	}
	return sp;

/* Reset the communication port with the backend. */
    case US_PQreset:
	if (items != 0)
	    fatal("Usage: &PQreset()");
	else {
	    /* int retval = 1; */

	    (void)PQreset();
	    str_numset(st[0], 1.0);
	}
	return sp;

/* Close communication ports with the backend. */
    case US_PQfinish:
	if (items != 0)
	    fatal("Usage: &PQfinish()");
	else {
	    /* int retval = 1; */

	    (void)PQfinish();
	    str_numset(st[0], 1.0);
	}
	return sp;

/* Trace. */
    case US_PQtrace:
	if (items != 0)
	    fatal("Usage: &PQtrace()");
	else {
	    /* int retval = 1; */

	    (void)PQtrace();
	    str_numset(st[0], 1.0);
	}
	return sp;

    case US_PQuntrace:
	if (items != 0)
	    fatal("Usage: &PQuntrace()");
	else {
	    /* int retval = 1; */

	    (void)PQuntrace();
	    str_numset(st[0], 1.0);
	}
	return sp;

    case US_pqdebug:
	if (items != 2)
	    fatal("Usage: &pqdebug($target, $msg)");
	else {
	    /* int retval = 1; */
	    char*	target =	str_get(st[1]);
	    char*	msg =		str_get(st[2]);

	    (void)pqdebug(target, msg);
	    str_numset(st[0], 1.0);
	}
	return sp;

    case US_pqdebug2:
	if (items != 3)
	    fatal("Usage: &pqdebug2($target, $msg1, $msg2)");
	else {
	    /* int retval = 1; */
	    char*	target =	str_get(st[1]);
	    char*	msg1 =		str_get(st[2]);
	    char*	msg2 =		str_get(st[3]);

	    (void)pqdebug2(target, msg1, msg2);
	    str_numset(st[0], 1.0);
	}
	return sp;

/*
 * Read in the initialization string to be passed to the POSTGRES backend.
 * The initstr has the format of
 *      USER,DATABASE,TTY,OPTION\n
 * If the variables do not have values yet, read in the values from the
 * environment variables.  If the environment variable does not have a
 * value, use the default value.
 */
    case US_read_initstr:
	if (items != 0)
	    fatal("Usage: &read_initstr()");
	else {
	    /* int retval = 1; */

	    (void)read_initstr();
	    str_numset(st[0], 1.0);
	}
	return sp;

/*
 * Process protal queries.
 * Return values are the same as PQexec().
 */
    case US_process_portal:
	if (items != 1)
	    fatal("Usage: &process_portal($rule_p)");
	else {
	    char* retval;
	    int		rule_p = (int	) dbl2uint(str_gnum(st[1]));

	    retval = process_portal(rule_p);
	    str_set(st[0], retval);
	}
	return sp;

/* Read and discard remarks. */
    case US_read_remark:
	if (items != 1)
	    fatal("Usage: &read_remark($id)");
	else {
	    int retval;
	    char*	id =		str_get(st[1]);

	    retval = read_remark(id);
	    str_numset(st[0],  uint2dbl((unsigned int) retval));
	}
	return sp;

/*
 * Send a function call to the POSTGRES backend.
 *
 * fnid         : function id
 * result_buf   : pointer to result buffer (&int if integer)
 * result_len   : length of return value.
 * result_is_int: If the result is an integer, this must be non-zero
 * args         : pointer to a NULL terminated arg array.
 *                      (length, if integer, and result-pointer)
 * nargs        : # of arguments in args array.
 */
    case US_PQfn:
	if (items != 6)
	    fatal("Usage: &PQfn($fnid, $result_buf, $result_len, $result_is_int, $args, $nargs)");
	else {
	    char* retval;
	    int		fnid =	 (int	) dbl2uint(str_gnum(st[1]));
	    int *	result_buf = (int *) dbl2uint(str_gnum(st[2]));
	    int		result_len = (int	) dbl2uint(str_gnum(st[3]));
	    int		result_is_int = (int	) dbl2uint(str_gnum(st[4]));
	    PQArgBlock*	args =	 (PQArgBlock*) dbl2uint(str_gnum(st[5]));
	    int		nargs =	 (int	) dbl2uint(str_gnum(st[6]));

	    retval = PQfn(fnid, result_buf, result_len, result_is_int, args, nargs);
	    str_set(st[0], retval);
	}
	return sp;

/*
 * Send a query to the POSTGRES backend.
 * The return value is a string.
 * If there is an error: return "E error-message".
 * If tuples are fetched from the backend, return "P portal-name".
 * If a query is executed successfully but no tuples fetched,
 * return "C query-command".
 */
    case US_PQexec:
	if (items != 1)
	    fatal("Usage: &PQexec($query)");
	else {
	    char* retval;
	    char*	query =		str_get(st[1]);

	    retval = PQexec(query);
	    str_set(st[0], retval);
	}
	return sp;

    case US_InitVacuumDemon:
	if (items != 6)
	    fatal("Usage: &InitVacuumDemon($host, $database, $terminal, $option, $port, $vacuum)");
	else {
	    /* int retval = 1; */
	    String	host =	 (String) dbl2uint(str_gnum(st[1]));
	    String	database = (String) dbl2uint(str_gnum(st[2]));
	    String	terminal = (String) dbl2uint(str_gnum(st[3]));
	    String	option = (String) dbl2uint(str_gnum(st[4]));
	    String	port =	 (String) dbl2uint(str_gnum(st[5]));
	    String	vacuum = (String) dbl2uint(str_gnum(st[6]));

	    (void)InitVacuumDemon(host, database, terminal, option, port, vacuum);
	    str_numset(st[0], 1.0);
	}
	return sp;

  default:
    fatal("Unimplemented user-defined subroutine");
  }
  return sp;
}

static int
userval(ix, str)
     int ix;
     STR *str;
{
  switch (ix) {
  case UV_PQhost:
    str_set(str, PQhost);
    break;
  case UV_PQport:
    str_set(str, PQport);
    break;
  case UV_PQtty:
    str_set(str, PQtty);
    break;
  case UV_PQoption:
    str_set(str, PQoption);
    break;
  case UV_PQdatabase:
    str_set(str, PQdatabase);
    break;
  case UV_PQportset:
    str_numset(str, PQportset);
    break;
  case UV_PQxactid:
    str_numset(str, PQxactid);
    break;
  case UV_PQinitstr:
    str_set(str, PQinitstr);
    break;
  case UV_PQtracep:
    str_numset(str, PQtracep);
    break;
  }
  return 0;
}

static int
userset(ix, str)
     int ix;
     STR *str;
{
  switch (ix) {
  case UV_PQhost:
    strcpy(PQhost, str_get(str));		/* hope it fits */
    break;
  case UV_PQport:
    strcpy(PQport, str_get(str));		/* hope it fits */
    break;
  case UV_PQtty:
    strcpy(PQtty, str_get(str));		/* hope it fits */
    break;
  case UV_PQoption:
    strcpy(PQoption, str_get(str));		/* hope it fits */
    break;
  case UV_PQdatabase:
    strcpy(PQdatabase, str_get(str));		/* hope it fits */
    break;
  case UV_PQportset:
    PQportset = dbl2uint(str_gnum(str));
    break;
  case UV_PQxactid:
    PQxactid = dbl2uint(str_gnum(str));
    break;
  case UV_PQinitstr:
    strcpy(PQinitstr, str_get(str));		/* hope it fits */
    break;
  case UV_PQtracep:
    PQtracep = dbl2uint(str_gnum(str));
    break;
  }
  return 0;
}