mdw@git.distorted.org.uk Git - jog/blob - rxglue.c

   1 /* -*-c-*-
   2  *
   3  * $Id: rxglue.c,v 1.4 2002/02/02 22:43:50 mdw Exp $
   4  *
   5  * REXX glue for C core functionality
   6  *
   7  * (c) 2001 Mark Wooding
   8  */
   9
  10 /*----- Licensing notice --------------------------------------------------*
  11  *
  12  * This file is part of Jog: Programming for a jogging machine.
  13  *
  14  * Jog is free software; you can redistribute it and/or modify
  15  * it under the terms of the GNU General Public License as published by
  16  * the Free Software Foundation; either version 2 of the License, or
  17  * (at your option) any later version.
  18  *
  19  * Jog is distributed in the hope that it will be useful,
  20  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  * GNU General Public License for more details.
  23  *
  24  * You should have received a copy of the GNU General Public License
  25  * along with Jog; if not, write to the Free Software Foundation,
  26  * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27  */
  28
  29 /*----- Revision history --------------------------------------------------*
  30  *
  31  * $Log: rxglue.c,v $
  32  * Revision 1.4  2002/02/02 22:43:50  mdw
  33  * Provide a decent interface for finding out about the audio cache and
  34  * configuring its capacity.
  35  *
  36  * Revision 1.3  2002/02/02 19:17:41  mdw
  37  * New audio subsystem.
  38  *
  39  * Revision 1.2  2002/01/30 09:22:48  mdw
  40  * Use memory-allocation functions provided by the REXX interpreter.
  41  * Now that configuration can be applied after initialization, allow
  42  * @txconf@ to set parameters.  Make @txsend@ add a newline to its output,
  43  * unless forbidden.
  44  *
  45  * Revision 1.1  2002/01/25 19:34:45  mdw
  46  * Initial revision
  47  *
  48  */
  49
  50 /*----- Header files ------------------------------------------------------*/
  51
  52 #ifdef HAVE_CONFIG_H
  53 #  include "config.h"
  54 #endif
  55
  56 #include <ctype.h>
  57 #include <errno.h>
  58 #include <limits.h>
  59 #include <stdarg.h>
  60 #include <stdio.h>
  61 #include <stdlib.h>
  62 #include <string.h>
  63 #include <time.h>
  64
  65 #include <sys/types.h>
  66 #include <sys/time.h>
  67 #include <unistd.h>
  68
  69 #define INCL_RXFUNC
  70 #define RX_STRONGTYPING
  71 #include <rexxsaa.h>
  72
  73 #include <mLib/alloc.h>
  74 #include <mLib/exc.h>
  75 #include <mLib/dstr.h>
  76
  77 #include "au.h"
  78 #include "aunum.h"
  79 #include "err.h"
  80 #include "rxglue.h"
  81 #include "txport.h"
  82
  83 /*----- Static variables --------------------------------------------------*/
  84
  85 static txport *tx = 0;
  86
  87 /*----- Memory allocation functions ---------------------------------------*/
  88
  89 static void *rx_alloc(size_t sz)
  90 {
  91   void *p = RexxAllocateMemory(sz);
  92   if (!p)
  93     THROW(EXC_NOMEM);
  94   return (p);
  95 }
  96
  97 static void rx_free(void *p)
  98 {
  99   RexxFreeMemory(p);
 100 }
 101
 102 /*----- Conversion functions ----------------------------------------------*/
 103
 104 /* --- @rxs_putm@ --- *
 105  *
 106  * Arguments:   @RXSTRING *x@ = pointer to REXX string structure
 107  *              For @rxs_putm@:
 108  *                @const void *p@ = pointer to data block
 109  *                @size_t sz@ = size of data
 110  *              For @rxs_putd@:
 111  *                @const dstr *d@ = pointer to source string
 112  *              For @rxs_putf@ and @rxs_vputf@:
 113  *                @const char *m@ = message format string
 114  *
 115  * Returns:     ---
 116  *
 117  * Use:         Stashes some text in an @RXSTRING@, overwriting whatever was
 118  *              there before.  We assume that the previous contents don't
 119  *              require freeing.
 120  */
 121
 122 #define RXS_PUTM(x, p, sz) do {                                         \
 123   RXSTRING *_x = (x);                                                   \
 124   const void *_p = (p);                                                 \
 125   size_t _sz = (sz);                                                    \
 126   if (!_x->strptr || _x->strlength < _sz)                               \
 127     _x->strptr = rx_alloc(_sz);                                         \
 128   memcpy(_x->strptr, _p, _sz);                                          \
 129   _x->strlength = _sz;                                                  \
 130 } while (0)
 131
 132 static void rxs_putm(RXSTRING *x, const void *p, size_t sz)
 133 {
 134   RXS_PUTM(x, p, sz);
 135 }
 136
 137 #define RXS_PUTD(x, d) do {                                             \
 138   dstr *_d = (d);                                                       \
 139   RXS_PUTM((x), _d->buf, _d->len);                                      \
 140 } while (0)
 141
 142 static void rxs_putd(RXSTRING *x, dstr *d) { RXS_PUTD(x, d); }
 143
 144 static void rxs_vputf(RXSTRING *x, const char *m, va_list *ap)
 145 {
 146   dstr d = DSTR_INIT;
 147   dstr_vputf(&d, m, ap);
 148   RXS_PUTD(x, &d);
 149   DDESTROY(&d);
 150 }
 151
 152 static void rxs_putf(RXSTRING *x, const char *m, ...)
 153 {
 154   va_list ap;
 155   dstr d = DSTR_INIT;
 156   va_start(ap, m);
 157   dstr_vputf(&d, m, &ap);
 158   RXS_PUTD(x, &d);
 159   va_end(ap);
 160   DDESTROY(&d);
 161 }
 162
 163 /* --- @rxs_get@ --- *
 164  *
 165  * Arguments:   @const RXSTRING *x@ = pointer to a REXX string
 166  *              @dstr *d@ = where to put it
 167  *
 168  * Returns:     ---
 169  *
 170  * Use:         Pulls a REXX string out and puts it in a dynamic string.
 171  */
 172
 173 #define RXS_GET(x, d) do {                                              \
 174   const RXSTRING *_x = (x);                                             \
 175   dstr *_dd = (d);                                                      \
 176   DPUTM(_dd, _x->strptr, _x->strlength);                                \
 177   DPUTZ(_dd);                                                           \
 178 } while (0)
 179
 180 static void rxs_get(const RXSTRING *x, dstr *d) { RXS_GET(x, d); }
 181
 182 /* --- @rxs_tol@ --- *
 183  *
 184  * Arguments:   @const RXSTRING *x@ = pointer to a REXX string
 185  *              @long *ii@ = where to put the answer
 186  *
 187  * Returns:     Zero on success, or nonzero on error.
 188  *
 189  * Use:         Fetches an integer from a REXX string.  This doesn't cope
 190  *              with multiprecision integers or similar silliness.
 191  */
 192
 193 static int rxs_tol(const RXSTRING *x, long *ii)
 194 {
 195   long i = 0;
 196   const char *p = x->strptr, *l = p + x->strlength;
 197   unsigned f = 0;
 198
 199 #define f_neg 1u
 200 #define f_ok 2u
 201
 202 #define MINR (LONG_MIN/10)
 203 #define MIND (LONG_MIN%10)
 204
 205   while (p < l && isspace((unsigned char)*p))
 206     p++;
 207   if (p >= l)
 208     return (-1);
 209   if (*p == '+')
 210     p++;
 211   else if (*p == '-') {
 212     f |= f_neg;
 213     p++;
 214   }
 215   while (p < l && isspace((unsigned char)*p))
 216     p++;
 217   while (p < l && isdigit((unsigned char)*p)) {
 218     int j = *p++ - '0';
 219     if (i < MINR || (i == MINR && -j < MIND))
 220       return (-1);
 221     i = (i * 10) - j;
 222     f |= f_ok;
 223   }
 224   while (p < l && isspace((unsigned char)*p))
 225     p++;
 226   if (p < l || !(f & f_ok))
 227     return (-1);
 228   if (!(f & f_neg)) {
 229     if (i < -LONG_MAX)
 230       return (-1);
 231     i = -i;
 232   }
 233   *ii = i;
 234   return (0);
 235
 236 #undef MINR
 237 #undef MIND
 238
 239 #undef f_neg
 240 #undef f_ok
 241 }
 242
 243 /* --- @rxs_block@ --- *
 244  *
 245  * Arguments:   @const RXSTRING *x@ = a REXX string
 246  *              @unsigned long *t@ = where to put the block spec
 247  *
 248  * Returns:     Zero if OK, nonzero on error.
 249  *
 250  * Use:         Picks out a blockingness spec.
 251  */
 252
 253 static int rxs_block(const RXSTRING *x, unsigned long *t)
 254 {
 255   long i;
 256
 257   if (!x->strptr || x->strlength < 1)
 258     return (-1);
 259   switch (x->strptr[0]) {
 260     case 'f':
 261     case 'F':
 262       *t = FOREVER;
 263       break;
 264     default:
 265       if (rxs_tol(x, &i) || i < 0)
 266         return (-1);
 267       *t = i;
 268       break;
 269   }
 270   return (0);
 271 }
 272
 273 /*----- REXX functions ----------------------------------------------------*/
 274
 275 static APIRET APIENTRY rxfn_test(const char *fn, ULONG ac, RXSTRING *av,
 276                                  const char *sn, RXSTRING *r)
 277 {
 278   ULONG i;
 279
 280   printf("test entry\n"
 281          "  fn = `%s'\n", fn);
 282   for (i = 0; i < ac; i++) {
 283     long l;
 284
 285     printf("  av[%lu] = `", i);
 286     fwrite(av[i].strptr, 1, av[i].strlength, stdout);
 287     if (rxs_tol(&av[i], &l))
 288       printf("'\n");
 289     else
 290       printf("' (%ld)\n", l);
 291   }
 292   printf("tx = `%s'; f = `%s'; c = `%s'.\n", txname, txfile, txconf);
 293   rxs_putf(r, "function `%s' completed ok", fn);
 294   return (0);
 295 }
 296
 297 /* --- @txname()@ ---
 298  *
 299  * Arguments:   ---
 300  *
 301  * Returns:     The currently-selected transport name.
 302  */
 303
 304 static APIRET APIENTRY rxfn_txname(const char *fn, ULONG ac, RXSTRING *av,
 305                                    const char *sn, RXSTRING *r)
 306 {
 307   if (ac)
 308     return (-1);
 309   rxs_putf(r, "%s", txname);
 310   return (0);
 311 }
 312
 313 /* --- @txfile()@ ---
 314  *
 315  * Arguments:   ---
 316  *
 317  * Returns:     The currently-selected transport filename.
 318  */
 319
 320 static APIRET APIENTRY rxfn_txfile(const char *fn, ULONG ac, RXSTRING *av,
 321                                    const char *sn, RXSTRING *r)
 322 {
 323   if (ac)
 324     return (-1);
 325   rxs_putf(r, "%s", txfile ? txfile : "");
 326   return (0);
 327 }
 328
 329 /* --- @txconf([CONFIG])@ ---
 330  *
 331  * Arguments:   @CONFIG@ = optional string to set
 332  *
 333  * Returns:     The currently-selected transport configuration string.
 334  */
 335
 336 static APIRET APIENTRY rxfn_txconf(const char *fn, ULONG ac, RXSTRING *av,
 337                                    const char *sn, RXSTRING *r)
 338 {
 339   if (ac > 1)
 340     return (-1);
 341   if (ac > 0 && av[0].strptr) {
 342     dstr d = DSTR_INIT;
 343     int rc;
 344     if (!tx)
 345       return (-1);
 346     rxs_get(&av[0], &d);
 347     rc = tx_configure(tx, d.buf);
 348     dstr_destroy(&d);
 349     if (rc)
 350       return (-1);
 351   }
 352   rxs_putf(r, "%s", txconf ? txconf : "");
 353   return (0);
 354 }
 355
 356 /* --- @txinit([NAME], [FILE], [CONFIG])@ ---
 357  *
 358  * Arguments:   @NAME@ = transport name to select
 359  *              @FILE@ = transport filename
 360  *              @CONFIG@ = transport configuration string
 361  *
 362  * Returns:     ---
 363  *
 364  * Use:         Initializes a transport using the given settings.  Omitted
 365  *              arguments are filled in from the command line, or internal
 366  *              defaults.
 367  */
 368
 369 static APIRET APIENTRY rxfn_txinit(const char *fn, ULONG ac, RXSTRING *av,
 370                                    const char *sn, RXSTRING *r)
 371 {
 372   const char *n = txname, *f = txfile, *c = txconf;
 373   dstr dn = DSTR_INIT, df = DSTR_INIT, dc = DSTR_INIT;
 374
 375   if (tx)
 376     return (-1);
 377   if (ac > 3)
 378     return (-1);
 379   if (ac >= 1 && av[0].strptr) {
 380     rxs_get(&av[0], &dn);
 381     n = dn.buf;
 382   }
 383   if (ac >= 2 && av[1].strptr) {
 384     rxs_get(&av[1], &df);
 385     f = df.buf;
 386   }
 387   if (ac >= 3 && av[2].strptr) {
 388     rxs_get(&av[2], &dc);
 389     c = dc.buf;
 390   }
 391   tx = tx_create(n, f, c);
 392   dstr_destroy(&dn);
 393   dstr_destroy(&df);
 394   dstr_destroy(&dc);
 395   if (!tx)
 396     return (-1);
 397   return (0);
 398 }
 399
 400 /* --- @txsend(STRING, [OPTION])@ --- *
 401  *
 402  * Arguments:   @STRING@ = string to send
 403  *              @OPTION@ = `l' or `n' (for `linebreak' or `nolinebreak')
 404  *
 405  * Returns:     ---
 406  *
 407  * Use:         Sends a string (exactly as written) to the transport.
 408  */
 409
 410 static APIRET APIENTRY rxfn_txsend(const char *fn, ULONG ac, RXSTRING *av,
 411                                    const char *sn, RXSTRING *r)
 412 {
 413   if ((ac != 1 && ac != 2) || !tx || !av[0].strptr)
 414     return (-1);
 415   tx_write(tx, av[0].strptr, av[0].strlength);
 416   if (ac == 1 || !av[1].strptr || !av[1].strlength ||
 417       av[1].strptr[0] == 'l' || av[1].strptr[0] == 'L')
 418     tx_newline(tx);
 419   return (0);
 420 }
 421
 422 /* --- @txrecv([MILLIS])@ --- *
 423  *
 424  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait, or `forever'
 425  *
 426  * Returns:     The string read (may be null if nothing available -- sorry).
 427  *
 428  * Use:         Reads the next line from the transport.  If @MILLIS@ is an
 429  *              integer, then give up after that many milliseconds of
 430  *              waiting; if it is `forever' (or anything beginning with an
 431  *              `f') then don't give up.  The default is to wait forever.
 432  */
 433
 434 static APIRET APIENTRY rxfn_txrecv(const char *fn, ULONG ac, RXSTRING *av,
 435                                    const char *sn, RXSTRING *r)
 436 {
 437   txline *l;
 438   unsigned long t = FOREVER;
 439
 440   if (ac > 1 || !tx)
 441     return (-1);
 442   if (ac >= 1 && rxs_block(&av[0], &t))
 443     return (-1);
 444
 445   l = tx_read(tx, t);
 446   if (!l)
 447     r->strlength = 0;
 448   else {
 449     rxs_putm(r, l->s, l->len);
 450     tx_freeline(l);
 451   }
 452   return (0);
 453 }
 454
 455 /* --- @TXEOF()@ --- *
 456  *
 457  * Arguments:   ---
 458  *
 459  * Returns:     True if end-of-file has been seen on the transport, otherwise
 460  *              false.
 461  */
 462
 463 static APIRET APIENTRY rxfn_txeof(const char *fn, ULONG ac, RXSTRING *av,
 464                                   const char *sn, RXSTRING *r)
 465 {
 466   if (ac || !tx)
 467     return (-1);
 468   rxs_putf(r, "%d", tx->s == TX_CLOSED && !tx->ll);
 469   return (0);
 470 }
 471
 472 /* --- @txready([MILLIS])@ --- *
 473  *
 474  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait, or `forever'
 475  *
 476  * Returns:     True if a line is ready, otherwise false.
 477  *
 478  * Use:         Returns whether the transport is ready for reading.  If
 479  *              @MILLIS@ is an integer, then wait for at most that many
 480  *              milliseconds before returning.  If @MILLIS@ is `forever' (or
 481  *              anything beginning with `f') then wait forever for
 482  *              readiness.  This isn't useless: it can trip the end-of-file
 483  *              detector.  If @MILLIS@ is omitted, return immediately (as if
 484  *              0 had been specified).
 485  */
 486
 487 static APIRET APIENTRY rxfn_txready(const char *fn, ULONG ac, RXSTRING *av,
 488                                     const char *sn, RXSTRING *r)
 489 {
 490   unsigned long t = 0;
 491
 492   if (ac > 1 || !tx)
 493     return (-1);
 494   if (ac >= 1 && rxs_block(&av[0], &t))
 495     return (-1);
 496   rxs_putf(r, "%d", !!tx_read(tx, t));
 497   return (0);
 498 }
 499
 500 /* --- @AUPLAY(TAG, [FLAG])@ --- *
 501  *
 502  * Arguments:   @TAG@ = audio sample tag to play
 503  *              @FLAG@ = a string to explain what to do more clearly.
 504  *
 505  * Returns:     True if it succeeded.
 506  *
 507  * Use:         Plays a sample.  If @FLAG@ begins with `t', don't report
 508  *              errors if the sample can't be found.
 509  */
 510
 511 static APIRET APIENTRY rxfn_auplay(const char *fn, ULONG ac, RXSTRING *av,
 512                                    const char *sn, RXSTRING *r)
 513 {
 514   dstr d = DSTR_INIT;
 515   int rc = 1;
 516
 517   if (ac < 1 || !av[0].strlength || ac > 2)
 518     return (-1);
 519   rxs_get(&av[0], &d);
 520   if (ac > 1 && av[1].strlength >= 1 &&
 521       (av[1].strptr[0] == 't' || av[1].strptr[0] == 'T'))
 522     rc = au_tryplay(d.buf);
 523   else
 524     au_play(d.buf);
 525   dstr_destroy(&d);
 526   rxs_putf(r, "%d", rc);
 527   return (0);
 528 }
 529
 530 /* --- @AUFETCH(TAG)@ --- *
 531  *
 532  * Arguments:   @TAG@ = audio sample tag to play
 533  *
 534  * Returns:     True if it succeeded.
 535  *
 536  * Use:         Prefetches a sample into the cache.
 537  */
 538
 539 static APIRET APIENTRY rxfn_aufetch(const char *fn, ULONG ac, RXSTRING *av,
 540                                     const char *sn, RXSTRING *r)
 541 {
 542   dstr d = DSTR_INIT;
 543   int rc = 0;
 544   au_sample *s;
 545   au_data *a;
 546
 547   if (ac < 1 || !av[0].strlength || ac > 1)
 548     return (-1);
 549   rxs_get(&av[0], &d);
 550   if ((s = au_find(d.buf)) != 0 &&
 551       (a = au_fetch(s)) != 0) {
 552     au_free(a);
 553     rc = 1;
 554   }
 555   dstr_destroy(&d);
 556   rxs_putf(r, "%d", rc);
 557   return (0);
 558 }
 559
 560 /* --- @AUNUM(TAG)@ --- *
 561  *
 562  * Arguments:   @NUM@ = a number to be read
 563  *
 564  * Returns:     ---
 565  *
 566  * Use:         Reads a number aloud to the audio device.
 567  */
 568
 569 static APIRET APIENTRY rxfn_aunum(const char *fn, ULONG ac, RXSTRING *av,
 570                                   const char *sn, RXSTRING *r)
 571 {
 572   dstr d = DSTR_INIT;
 573
 574   if (ac < 1 || !av[0].strlength || ac > 1)
 575     return (-1);
 576   rxs_get(&av[0], &d);
 577   aunum(d.buf);
 578   dstr_destroy(&d);
 579   return (0);
 580 }
 581
 582 /* --- @AUCACHE([FLAG], [VALUE, ...]@ --- *
 583  *
 584  * Arguments:   @FLAG@ = operation to perform
 585  *
 586  * Returns:     Dependent on operation.
 587  *
 588  * Use:         If @FLAG@ is omitted or `Info', returns audio cache usage
 589  *              information as words in the following order:
 590  *
 591  *                sz_max                Maximum allowed cache size
 592  *                sz_total              Total size used by samples
 593  *                sz_spare              Size used by `spare' samples
 594  *                sz_queue              Size used by queued samples
 595  *                n_total               Total number of cached samples
 596  *                n_spare               Number of `spare' samples
 597  *                n_queue               Number of queued samples
 598  *                hits                  Number of cache hits
 599  *                misses                Number of cache misses
 600  *
 601  *              If @FLAG@ is `Max', sets the maximum cache size to the first
 602  *              @VALUE@ (if set), and returns the old maximum on its own.
 603  *
 604  *              If @FLAG@ is `Usage', returns the `sz_*' items, as a list of
 605  *              words.
 606  *
 607  *              If @FLAGS@ is `Numbers', returns the `n_*' items, as a list
 608  *              of words.
 609  *
 610  *              If @FLAGS@ is `Hits', returns `hits' and `misses' as a pair
 611  *              of words.
 612  */
 613
 614 static APIRET APIENTRY rxfn_aucache(const char *fn, ULONG ac, RXSTRING *av,
 615                                     const char *sn, RXSTRING *r)
 616 {
 617   int i = 1;
 618   au_cacheinfo c;
 619
 620   au_getcacheinfo(&c);
 621   if (ac < 1 || !av[0].strlength)
 622     goto info;
 623   switch (av[0].strptr[0]) {
 624     case 'i': case 'I': info:
 625       rxs_putf(r, "%lu %lu %lu %lu %u %u %u %lu %lu",
 626                (unsigned long)c.sz_max, (unsigned long)c.sz_total,
 627                (unsigned long)c.sz_spare, (unsigned long)c.sz_queue,
 628                c.n_total, c.n_spare, c.n_total, c.hits, c.misses);
 629       break;
 630     case 'm': case 'M':
 631       if (ac > i) {
 632         long max;
 633         if (rxs_tol(&av[i], &max))
 634           return (-1);
 635         au_setcachelimit(max);
 636         i++;
 637       }
 638       rxs_putf(r, "%lu", (unsigned long)c.sz_max);
 639       break;
 640     case 'u': case 'U':
 641       rxs_putf(r, "%lu %lu %lu %lu",
 642                (unsigned long)c.sz_max, (unsigned long)c.sz_total,
 643                (unsigned long)c.sz_spare, (unsigned long)c.sz_queue);
 644       break;
 645     case 'n': case 'N':
 646       rxs_putf(r, "%u %u %u", c.n_total, c.n_spare, c.n_total);
 647       break;
 648     case 'h': case 'H':
 649       rxs_putf(r, "%lu %lu", c.hits, c.misses);
 650       break;
 651     default:
 652       return (-1);
 653   }
 654   if (i > ac)
 655     return (-1);
 656   return (0);
 657 }
 658
 659 /* --- @MILLIWAIT(MILLIS)@ --- *
 660  *
 661  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait
 662  *
 663  * Returns:     ---
 664  *
 665  * Use:         Waits for @MILLIS@ milliseconds.  Always.
 666  */
 667
 668 static APIRET APIENTRY rxfn_milliwait(const char *fn, ULONG ac, RXSTRING *av,
 669                                       const char *sn, RXSTRING *r)
 670 {
 671   long l;
 672   struct timeval tv;
 673
 674   if (ac != 1 || !av[0].strptr)
 675     return (-1);
 676   if (rxs_tol(&av[0], &l) || l < 0)
 677     return (-1);
 678   tv.tv_sec = l / 1000;
 679   tv.tv_usec = (l % 1000) * 1000;
 680   select(0, 0, 0, 0, &tv);
 681   return (0);
 682 }
 683
 684 /*----- Initialization ----------------------------------------------------*/
 685
 686 struct rxfntab { char *name; RexxFunctionHandler *fn; };
 687
 688 static const struct rxfntab rxfntab[] = {
 689   { "test",             rxfn_test },
 690   { "txname",           rxfn_txname },
 691   { "txfile",           rxfn_txfile },
 692   { "txconf",           rxfn_txconf },
 693   { "txinit",           rxfn_txinit },
 694   { "txsend",           rxfn_txsend },
 695   { "txrecv",           rxfn_txrecv },
 696   { "txeof",            rxfn_txeof },
 697   { "txready",          rxfn_txready },
 698   { "auplay",           rxfn_auplay },
 699   { "aufetch",          rxfn_aufetch },
 700   { "aucache",          rxfn_aucache },
 701   { "aunum",            rxfn_aunum },
 702   { "milliwait",        rxfn_milliwait },
 703   { 0,          0 }
 704 };
 705
 706 /* --- @rx_init@ --- *
 707  *
 708  * Arguments:   ---
 709  *
 710  * Returns:     ---
 711  *
 712  * Use:         Initializes the REXX external functions.
 713  */
 714
 715 void rx_init(void)
 716 {
 717   const struct rxfntab *f;
 718   int rc;
 719
 720   for (f = rxfntab; f->fn; f++) {
 721     if ((rc = RexxRegisterFunctionExe(f->name, f->fn)) != 0) {
 722       err_report(ERR_RXGLUE, ERRRX_INIT, rc,
 723                  "couldn't register function `%s' (code %d)", f->name, rc);
 724       abort();
 725     }
 726   }
 727 }
 728
 729 /*----- Running REXX programs ---------------------------------------------*/
 730
 731 /* --- @rx_run@ --- *
 732  *
 733  * Arguments:   @const char *name@ = pointer to filename (or null)
 734  *              @const void *p@ = pointer to program text
 735  *              @size_t sz@ = size of program text
 736  *              @int ac@ = number of arguments
 737  *              @const char *const *av@ = vector of command-line arguments
 738  *
 739  * Returns:     Exit code from program.
 740  *
 741  * Use:         Runs a REXX script from memory.
 742  */
 743
 744 int rx_run(const char *name, const void *p, size_t sz,
 745            int ac, const char *const *av)
 746 {
 747   RXSTRING prog[2];
 748   RXSTRING *argv;
 749   RXSTRING res;
 750   dstr d = DSTR_INIT;
 751   short badrc;
 752   int rc;
 753   int i;
 754
 755   /* --- Set things up --- */
 756
 757   if (!name)
 758     name = "incore";
 759   MAKERXSTRING(prog[0], (void *)p, sz);
 760   MAKERXSTRING(prog[1], 0, 0);
 761   argv = rx_alloc(ac * sizeof(*argv));
 762   for (i = 0; i < ac; i++)
 763     MAKERXSTRING(argv[i], (char *)av[i], strlen(av[i]));
 764
 765   /* --- Run the script --- */
 766
 767   MAKERXSTRING(res, 0, 0);
 768   rc = RexxStart(ac, argv, name, prog,
 769                  "SYSTEM", RXSUBROUTINE, 0, &badrc, &res);
 770   if (rc) {
 771     rx_free(RXSTRPTR(res));
 772     rx_free(argv);
 773     if (rc < 0)
 774       err_report(ERR_RXERR, 0, -rc, "rexx error from script `%s'", name);
 775     else
 776       err_report(ERR_RXGLUE, ERRRX_INTERP, rc, "intepreter internal error");
 777     return (-1);
 778   }
 779
 780   /* --- Pick apart the results --- */
 781
 782   dstr_putm(&d, RXSTRPTR(res), RXSTRLEN(res));
 783   rx_free(RXSTRPTR(res));
 784   rx_free(argv);
 785   dstr_putz(&d);
 786   rc = atoi(d.buf);
 787   dstr_destroy(&d);
 788   return (rc);
 789 }
 790
 791 /* --- @rx_runfile@ --- *
 792  *
 793  * Arguments:   @const char *name@ = pointer to filename
 794  *              @int ac@ = number of command-line arguments
 795  *              @const char *const *av@ = vector of command-line arguments
 796  *
 797  * Returns:     Exit code from program.
 798  *
 799  * Use:         Runs a REXX script from a file, given its name.
 800  */
 801
 802 int rx_runfile(const char *name, int ac, const char *const *av)
 803 {
 804   FILE *fp;
 805   dstr d = DSTR_INIT;
 806   char buf[BUFSIZ];
 807   size_t n;
 808   int rc;
 809
 810   /* --- Read the file into memory --- *
 811    *
 812    * This way avoids any crapness in the REXX implementation and means we can
 813    * report errors in a more sensible way.
 814    */
 815
 816   if ((fp = fopen(name, "r")) == 0)
 817     goto fail_0;
 818   do {
 819     n = fread(buf, 1, sizeof(buf), fp);
 820     DPUTM(&d, buf, n);
 821   } while (n == sizeof(buf));
 822   if (ferror(fp))
 823     goto fail_1;
 824   fclose(fp);
 825
 826   /* --- Now do the from-memory thing --- */
 827
 828   rc = rx_run(name, d.buf, d.len, ac, av);
 829   dstr_destroy(&d);
 830   return (rc);
 831
 832   /* --- Tidy up on errors --- */
 833
 834 fail_1:
 835   dstr_destroy(&d);
 836   fclose(fp);
 837 fail_0:
 838   err_report(ERR_RXGLUE, ERRRX_SCRIPTREAD, errno,
 839              "couldn't read script `%s': %s", name, strerror(errno));
 840   return (-1);
 841 }
 842
 843 /*----- That's all, folks -------------------------------------------------*/