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