infra: Clean up project setup

[jog] / rxglue.c

/* -*-c-*-
 *
 * $Id: rxglue.c,v 1.4 2002/02/02 22:43:50 mdw Exp $
 *
 * REXX glue for C core functionality
 *
 * (c) 2001 Mark Wooding
 */

/*----- Licensing notice --------------------------------------------------* 
 *
 * This file is part of Jog: Programming for a jogging machine.
 *
 * Jog is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * Jog is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with Jog; if not, write to the Free Software Foundation,
 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */

/*----- Header files ------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include <ctype.h>
#include <errno.h>
#include <limits.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

#include <sys/types.h>
#include <sys/time.h>
#include <unistd.h>

#define INCL_RXFUNC
#define RX_STRONGTYPING
#include <rexxsaa.h>

#include <mLib/alloc.h>
#include <mLib/exc.h>
#include <mLib/dstr.h>

#include "au.h"
#include "aunum.h"
#include "err.h"
#include "rxglue.h"
#include "txport.h"

/*----- Static variables --------------------------------------------------*/

static txport *tx = 0;

/*----- Memory allocation functions ---------------------------------------*/

static void *rx_alloc(size_t sz)
{
  void *p = RexxAllocateMemory(sz);
  if (!p)
    THROW(EXC_NOMEM);
  return (p);
}

static void rx_free(void *p)
{
  RexxFreeMemory(p);
}

/*----- Conversion functions ----------------------------------------------*/

/* --- @rxs_putm@ --- *
 *
 * Arguments:	@RXSTRING *x@ = pointer to REXX string structure
 *		For @rxs_putm@:
 *		  @const void *p@ = pointer to data block
 *		  @size_t sz@ = size of data
 *		For @rxs_putd@:
 *		  @const dstr *d@ = pointer to source string
 *		For @rxs_putf@ and @rxs_vputf@:
 *		  @const char *m@ = message format string
 *
 * Returns:	---
 *
 * Use:		Stashes some text in an @RXSTRING@, overwriting	whatever was
 *		there before.  We assume that the previous contents don't
 *		require freeing.
 */

#define RXS_PUTM(x, p, sz) do {						\
  RXSTRING *_x = (x);							\
  const void *_p = (p);							\
  size_t _sz = (sz);							\
  if (!_x->strptr || _x->strlength < _sz)				\
    _x->strptr = rx_alloc(_sz);						\
  memcpy(_x->strptr, _p, _sz);						\
  _x->strlength = _sz;							\
} while (0)

static void rxs_putm(RXSTRING *x, const void *p, size_t sz)
{
  RXS_PUTM(x, p, sz);
}

#define RXS_PUTD(x, d) do {						\
  dstr *_d = (d);							\
  RXS_PUTM((x), _d->buf, _d->len);					\
} while (0)

static void rxs_putd(RXSTRING *x, dstr *d) { RXS_PUTD(x, d); }

static void rxs_vputf(RXSTRING *x, const char *m, va_list *ap)
{
  dstr d = DSTR_INIT;
  dstr_vputf(&d, m, ap);
  RXS_PUTD(x, &d);
  DDESTROY(&d);
}

static void rxs_putf(RXSTRING *x, const char *m, ...)
{
  va_list ap;
  dstr d = DSTR_INIT;
  va_start(ap, m);
  dstr_vputf(&d, m, &ap);
  RXS_PUTD(x, &d);
  va_end(ap);
  DDESTROY(&d);
}

/* --- @rxs_get@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = pointer to a REXX string
 *		@dstr *d@ = where to put it
 *
 * Returns:	---
 *
 * Use:		Pulls a REXX string out and puts it in a dynamic string.
 */

#define RXS_GET(x, d) do {						\
  const RXSTRING *_x = (x);						\
  dstr *_dd = (d);							\
  DPUTM(_dd, _x->strptr, _x->strlength);				\
  DPUTZ(_dd);								\
} while (0)

static void rxs_get(const RXSTRING *x, dstr *d) { RXS_GET(x, d); }

/* --- @rxs_tol@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = pointer to a REXX string
 *		@long *ii@ = where to put the answer
 *
 * Returns:	Zero on success, or nonzero on error.
 *
 * Use:		Fetches an integer from a REXX string.  This doesn't cope
 *		with multiprecision integers or similar silliness.
 */

static int rxs_tol(const RXSTRING *x, long *ii)
{
  long i = 0;
  const char *p = x->strptr, *l = p + x->strlength;
  unsigned f = 0;

#define f_neg 1u
#define f_ok 2u

#define MINR (LONG_MIN/10)
#define MIND (LONG_MIN%10)

  while (p < l && isspace((unsigned char)*p))
    p++;
  if (p >= l)
    return (-1);
  if (*p == '+')
    p++;
  else if (*p == '-') {
    f |= f_neg;
    p++;
  }
  while (p < l && isspace((unsigned char)*p))
    p++;
  while (p < l && isdigit((unsigned char)*p)) {
    int j = *p++ - '0';
    if (i < MINR || (i == MINR && -j < MIND))
      return (-1);
    i = (i * 10) - j;
    f |= f_ok;
  }
  while (p < l && isspace((unsigned char)*p))
    p++;
  if (p < l || !(f & f_ok))
    return (-1);
  if (!(f & f_neg)) {
    if (i < -LONG_MAX)
      return (-1);
    i = -i;
  }
  *ii = i;
  return (0);

#undef MINR
#undef MIND

#undef f_neg
#undef f_ok
}

/* --- @rxs_block@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = a REXX string
 *		@unsigned long *t@ = where to put the block spec
 *
 * Returns:	Zero if OK, nonzero on error.
 *
 * Use:		Picks out a blockingness spec.
 */

static int rxs_block(const RXSTRING *x, unsigned long *t)
{
  long i;

  if (!x->strptr || x->strlength < 1)
    return (-1);
  switch (x->strptr[0]) {
    case 'f':
    case 'F':
      *t = FOREVER;
      break;
    default:
      if (rxs_tol(x, &i) || i < 0)
	return (-1);
      *t = i;
      break;
  }
  return (0);
}

/*----- REXX functions ----------------------------------------------------*/

static APIRET APIENTRY rxfn_test(const char *fn, ULONG ac, RXSTRING *av,
				 const char *sn, RXSTRING *r)
{
  ULONG i;

  printf("test entry\n"
	 "  fn = `%s'\n", fn);
  for (i = 0; i < ac; i++) {
    long l;

    printf("  av[%lu] = `", i);
    fwrite(av[i].strptr, 1, av[i].strlength, stdout);
    if (rxs_tol(&av[i], &l))
      printf("'\n");
    else
      printf("' (%ld)\n", l);
  }
  printf("tx = `%s'; f = `%s'; c = `%s'.\n", txname, txfile, txconf);
  rxs_putf(r, "function `%s' completed ok", fn);
  return (0);
}

/* --- @txname()@ ---
 *
 * Arguments:	---
 *
 * Returns:	The currently-selected transport name.
 */

static APIRET APIENTRY rxfn_txname(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  if (ac)
    return (-1);
  rxs_putf(r, "%s", txname);
  return (0);
}

/* --- @txfile()@ ---
 *
 * Arguments:	---
 *
 * Returns:	The currently-selected transport filename.
 */

static APIRET APIENTRY rxfn_txfile(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  if (ac)
    return (-1);
  rxs_putf(r, "%s", txfile ? txfile : "");
  return (0);
}

/* --- @txconf([CONFIG])@ ---
 *
 * Arguments:	@CONFIG@ = optional string to set
 *
 * Returns:	The currently-selected transport configuration string.
 */

static APIRET APIENTRY rxfn_txconf(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  if (ac > 1)
    return (-1);
  if (ac > 0 && av[0].strptr) {
    dstr d = DSTR_INIT;
    int rc;
    if (!tx)
      return (-1);
    rxs_get(&av[0], &d);
    rc = tx_configure(tx, d.buf);
    dstr_destroy(&d);
    if (rc)
      return (-1);
  }
  rxs_putf(r, "%s", txconf ? txconf : "");
  return (0);
}
  
/* --- @txinit([NAME], [FILE], [CONFIG])@ ---
 *
 * Arguments:	@NAME@ = transport name to select
 *		@FILE@ = transport filename
 *		@CONFIG@ = transport configuration string
 *
 * Returns:	---
 *
 * Use:		Initializes a transport using the given settings.  Omitted
 *		arguments are filled in from the command line, or internal
 *		defaults.
 */

static APIRET APIENTRY rxfn_txinit(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  const char *n = txname, *f = txfile, *c = txconf;
  dstr dn = DSTR_INIT, df = DSTR_INIT, dc = DSTR_INIT;

  if (tx)
    return (-1);
  if (ac > 3)
    return (-1);
  if (ac >= 1 && av[0].strptr) {
    rxs_get(&av[0], &dn);
    n = dn.buf;
  }
  if (ac >= 2 && av[1].strptr) {
    rxs_get(&av[1], &df);
    f = df.buf;
  }
  if (ac >= 3 && av[2].strptr) {
    rxs_get(&av[2], &dc);
    c = dc.buf;
  }
  tx = tx_create(n, f, c);
  dstr_destroy(&dn);
  dstr_destroy(&df);
  dstr_destroy(&dc);
  if (!tx)
    return (-1);
  return (0);
}

/* --- @txsend(STRING, [OPTION])@ --- *
 *
 * Arguments:	@STRING@ = string to send
 *		@OPTION@ = `l' or `n' (for `linebreak' or `nolinebreak')
 *
 * Returns:	---
 *
 * Use:		Sends a string (exactly as written) to the transport.
 */

static APIRET APIENTRY rxfn_txsend(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  if ((ac != 1 && ac != 2) || !tx || !av[0].strptr)
    return (-1);
  tx_write(tx, av[0].strptr, av[0].strlength);
  if (ac == 1 || !av[1].strptr || !av[1].strlength ||
      av[1].strptr[0] == 'l' || av[1].strptr[0] == 'L')
    tx_newline(tx);
  return (0);
}

/* --- @txrecv([MILLIS])@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait, or `forever'
 *
 * Returns:	The string read (may be null if nothing available -- sorry).
 *
 * Use:		Reads the next line from the transport.  If @MILLIS@ is an
 *		integer, then give up after that many milliseconds of
 *		waiting; if it is `forever' (or anything beginning with an
 *		`f') then don't give up.  The default is to wait forever.
 */

static APIRET APIENTRY rxfn_txrecv(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  txline *l;
  unsigned long t = FOREVER;

  if (ac > 1 || !tx)
    return (-1);
  if (ac >= 1 && rxs_block(&av[0], &t))
    return (-1);

  l = tx_read(tx, t);
  if (!l)
    r->strlength = 0;
  else {
    rxs_putm(r, l->s, l->len);
    tx_freeline(l);
  }
  return (0);
}

/* --- @TXEOF()@ --- *
 *
 * Arguments:	---
 *
 * Returns:	True if end-of-file has been seen on the transport, otherwise
 *		false.
 */

static APIRET APIENTRY rxfn_txeof(const char *fn, ULONG ac, RXSTRING *av,
				  const char *sn, RXSTRING *r)
{
  if (ac || !tx)
    return (-1);
  rxs_putf(r, "%d", tx->s == TX_CLOSED && !tx->ll);
  return (0);
}

/* --- @txready([MILLIS])@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait, or `forever'
 *
 * Returns:	True if a line is ready, otherwise false.
 *
 * Use:		Returns whether the transport is ready for reading.  If
 *		@MILLIS@ is an integer, then wait for at most that many
 *		milliseconds before returning.  If @MILLIS@ is `forever' (or
 *		anything beginning with `f') then wait forever for
 *		readiness.  This isn't useless: it can trip the end-of-file
 *		detector.  If @MILLIS@ is omitted, return immediately (as if
 *		0 had been specified).
 */

static APIRET APIENTRY rxfn_txready(const char *fn, ULONG ac, RXSTRING *av,
				    const char *sn, RXSTRING *r)
{
  unsigned long t = 0;

  if (ac > 1 || !tx)
    return (-1);
  if (ac >= 1 && rxs_block(&av[0], &t))
    return (-1);
  rxs_putf(r, "%d", !!tx_read(tx, t));
  return (0);
}

/* --- @AUPLAY(TAG, [FLAG])@ --- *
 *
 * Arguments:	@TAG@ = audio sample tag to play
 *		@FLAG@ = a string to explain what to do more clearly.
 *
 * Returns:	True if it succeeded.
 *
 * Use:		Plays a sample.  If @FLAG@ begins with `t', don't report
 *		errors if the sample can't be found.
 */

static APIRET APIENTRY rxfn_auplay(const char *fn, ULONG ac, RXSTRING *av,
				   const char *sn, RXSTRING *r)
{
  dstr d = DSTR_INIT;
  int rc = 1;

  if (ac < 1 || !av[0].strlength || ac > 2)
    return (-1);
  rxs_get(&av[0], &d);
  if (ac > 1 && av[1].strlength >= 1 &&
      (av[1].strptr[0] == 't' || av[1].strptr[0] == 'T'))
    rc = au_tryplay(d.buf);
  else
    au_play(d.buf);
  dstr_destroy(&d);
  rxs_putf(r, "%d", rc);
  return (0);
}

/* --- @AUFETCH(TAG)@ --- *
 *
 * Arguments:	@TAG@ = audio sample tag to play
 *
 * Returns:	True if it succeeded.
 *
 * Use:		Prefetches a sample into the cache.
 */

static APIRET APIENTRY rxfn_aufetch(const char *fn, ULONG ac, RXSTRING *av,
				    const char *sn, RXSTRING *r)
{
  dstr d = DSTR_INIT;
  int rc = 0;
  au_sample *s;
  au_data *a;

  if (ac < 1 || !av[0].strlength || ac > 1)
    return (-1);
  rxs_get(&av[0], &d);
  if ((s = au_find(d.buf)) != 0 &&
      (a = au_fetch(s)) != 0) {
    au_free(a);
    rc = 1;
  }
  dstr_destroy(&d);
  rxs_putf(r, "%d", rc);
  return (0);
}

/* --- @AUNUM(TAG)@ --- *
 *
 * Arguments:	@NUM@ = a number to be read
 *
 * Returns:	---
 *
 * Use:		Reads a number aloud to the audio device.
 */

static APIRET APIENTRY rxfn_aunum(const char *fn, ULONG ac, RXSTRING *av,
				  const char *sn, RXSTRING *r)
{
  dstr d = DSTR_INIT;

  if (ac < 1 || !av[0].strlength || ac > 1)
    return (-1);
  rxs_get(&av[0], &d);
  aunum(d.buf);
  dstr_destroy(&d);
  return (0);
}

/* --- @AUCACHE([FLAG], [VALUE, ...]@ --- *
 *
 * Arguments:	@FLAG@ = operation to perform
 *
 * Returns:	Dependent on operation.
 *
 * Use:		If @FLAG@ is omitted or `Info', returns audio cache usage
 *		information as words in the following order:
 *
 *		  sz_max		Maximum allowed cache size
 *		  sz_total		Total size used by samples
 *		  sz_spare		Size used by `spare' samples
 *		  sz_queue		Size used by queued samples
 *		  n_total		Total number of cached samples
 *		  n_spare		Number of `spare' samples
 *		  n_queue		Number of queued samples
 *		  hits			Number of cache hits
 *		  misses		Number of cache misses
 *
 *		If @FLAG@ is `Max', sets the maximum cache size to the first
 *		@VALUE@ (if set), and returns the old maximum on its own.
 *
 *		If @FLAG@ is `Usage', returns the `sz_*' items, as a list of
 *		words.
 *
 *		If @FLAGS@ is `Numbers', returns the `n_*' items, as a list
 *		of words.
 *
 *		If @FLAGS@ is `Hits', returns `hits' and `misses' as a pair
 *		of words.
 */

static APIRET APIENTRY rxfn_aucache(const char *fn, ULONG ac, RXSTRING *av,
				    const char *sn, RXSTRING *r)
{
  int i = 1;
  au_cacheinfo c;

  au_getcacheinfo(&c);
  if (ac < 1 || !av[0].strlength)
    goto info;
  switch (av[0].strptr[0]) {
    case 'i': case 'I': info:
      rxs_putf(r, "%lu %lu %lu %lu %u %u %u %lu %lu",
	       (unsigned long)c.sz_max, (unsigned long)c.sz_total,
	       (unsigned long)c.sz_spare, (unsigned long)c.sz_queue,
	       c.n_total, c.n_spare, c.n_total, c.hits, c.misses);
      break;
    case 'm': case 'M':
      if (ac > i) {
	long max;
	if (rxs_tol(&av[i], &max))
	  return (-1);
	au_setcachelimit(max);
	i++;
      }
      rxs_putf(r, "%lu", (unsigned long)c.sz_max);
      break;
    case 'u': case 'U':
      rxs_putf(r, "%lu %lu %lu %lu",
	       (unsigned long)c.sz_max, (unsigned long)c.sz_total,
	       (unsigned long)c.sz_spare, (unsigned long)c.sz_queue);
      break;
    case 'n': case 'N':
      rxs_putf(r, "%u %u %u", c.n_total, c.n_spare, c.n_total);
      break;
    case 'h': case 'H':
      rxs_putf(r, "%lu %lu", c.hits, c.misses);
      break;
    default:
      return (-1);
  }
  if (i > ac)
    return (-1);
  return (0);
}

/* --- @MILLIWAIT(MILLIS)@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait
 *
 * Returns:	---
 *
 * Use:		Waits for @MILLIS@ milliseconds.  Always.
 */

static APIRET APIENTRY rxfn_milliwait(const char *fn, ULONG ac, RXSTRING *av,
				      const char *sn, RXSTRING *r)
{
  long l;
  struct timeval tv;

  if (ac != 1 || !av[0].strptr)
    return (-1);
  if (rxs_tol(&av[0], &l) || l < 0)
    return (-1);
  tv.tv_sec = l / 1000;
  tv.tv_usec = (l % 1000) * 1000;
  select(0, 0, 0, 0, &tv);
  return (0);
}

/*----- Initialization ----------------------------------------------------*/

struct rxfntab { char *name; RexxFunctionHandler *fn; };

static const struct rxfntab rxfntab[] = {
  { "test",		rxfn_test },
  { "txname",		rxfn_txname },
  { "txfile",		rxfn_txfile },
  { "txconf",		rxfn_txconf },
  { "txinit",		rxfn_txinit },
  { "txsend",		rxfn_txsend },
  { "txrecv",		rxfn_txrecv },
  { "txeof",		rxfn_txeof },
  { "txready",		rxfn_txready },
  { "auplay",		rxfn_auplay },
  { "aufetch",		rxfn_aufetch },
  { "aucache",		rxfn_aucache },
  { "aunum",		rxfn_aunum },
  { "milliwait",	rxfn_milliwait },
  { 0,		0 }
};

/* --- @rx_init@ --- *
 *
 * Arguments:	---
 *
 * Returns:	---
 *
 * Use:		Initializes the REXX external functions.
 */

void rx_init(void)
{
  const struct rxfntab *f;
  int rc;

  for (f = rxfntab; f->fn; f++) {
    if ((rc = RexxRegisterFunctionExe(f->name, f->fn)) != 0) {
      err_report(ERR_RXGLUE, ERRRX_INIT, rc,
		 "couldn't register function `%s' (code %d)", f->name, rc);
      abort();
    }
  }
}

/*----- Running REXX programs ---------------------------------------------*/

/* --- @rx_run@ --- *
 *
 * Arguments:	@const char *name@ = pointer to filename (or null)
 *		@const void *p@ = pointer to program text
 *		@size_t sz@ = size of program text
 *		@int ac@ = number of arguments
 *		@const char *const *av@ = vector of command-line arguments
 *
 * Returns:	Exit code from program.
 *
 * Use:		Runs a REXX script from memory.
 */

int rx_run(const char *name, const void *p, size_t sz,
	   int ac, const char *const *av)
{
  RXSTRING prog[2];
  RXSTRING *argv;
  RXSTRING res;
  dstr d = DSTR_INIT;
  short badrc;
  int rc;
  int i;

  /* --- Set things up --- */

  if (!name)
    name = "incore";
  MAKERXSTRING(prog[0], (void *)p, sz);
  MAKERXSTRING(prog[1], 0, 0);
  argv = rx_alloc(ac * sizeof(*argv));
  for (i = 0; i < ac; i++)
    MAKERXSTRING(argv[i], (char *)av[i], strlen(av[i]));

  /* --- Run the script --- */

  MAKERXSTRING(res, 0, 0);
  rc = RexxStart(ac, argv, name, prog,
		 "SYSTEM", RXSUBROUTINE, 0, &badrc, &res);
  if (rc) {
    rx_free(RXSTRPTR(res));
    rx_free(argv);
    if (rc < 0)
      err_report(ERR_RXERR, 0, -rc, "rexx error from script `%s'", name);
    else
      err_report(ERR_RXGLUE, ERRRX_INTERP, rc, "intepreter internal error");
    return (-1);
  }

  /* --- Pick apart the results --- */

  dstr_putm(&d, RXSTRPTR(res), RXSTRLEN(res));
  rx_free(RXSTRPTR(res));
  rx_free(argv);
  dstr_putz(&d);
  rc = atoi(d.buf);
  dstr_destroy(&d);
  return (rc);
}

/* --- @rx_runfile@ --- *
 *
 * Arguments:	@const char *name@ = pointer to filename
 *		@int ac@ = number of command-line arguments
 *		@const char *const *av@ = vector of command-line arguments
 *
 * Returns:	Exit code from program.
 *
 * Use:		Runs a REXX script from a file, given its name.
 */

int rx_runfile(const char *name, int ac, const char *const *av)
{
  FILE *fp;
  dstr d = DSTR_INIT;
  char buf[BUFSIZ];
  size_t n;
  int rc;

  /* --- Read the file into memory --- *
   *
   * This way avoids any crapness in the REXX implementation and means we can
   * report errors in a more sensible way.
   */

  if ((fp = fopen(name, "r")) == 0)
    goto fail_0;
  do {
    n = fread(buf, 1, sizeof(buf), fp);
    DPUTM(&d, buf, n);
  } while (n == sizeof(buf));
  if (ferror(fp))
    goto fail_1;
  fclose(fp);

  /* --- Now do the from-memory thing --- */

  rc = rx_run(name, d.buf, d.len, ac, av);
  dstr_destroy(&d);
  return (rc);

  /* --- Tidy up on errors --- */

fail_1:
  dstr_destroy(&d);
  fclose(fp);
fail_0:
  err_report(ERR_RXGLUE, ERRRX_SCRIPTREAD, errno,
	     "couldn't read script `%s': %s", name, strerror(errno));
  return (-1);
}

/*----- That's all, folks -------------------------------------------------*/