chiark - git - mdw - jog/blob - rxglue.c

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