2ec1e693 |
1 | /* -*-c-*- |
2 | * |
af666e6f |
3 | * $Id: rxglue.c,v 1.4 2002/02/02 22:43:50 mdw Exp $ |
2ec1e693 |
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 | |
2ec1e693 |
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> |
661c4bdc |
53 | #include <mLib/exc.h> |
2ec1e693 |
54 | #include <mLib/dstr.h> |
55 | |
e9060e7e |
56 | #include "au.h" |
57 | #include "aunum.h" |
2ec1e693 |
58 | #include "err.h" |
59 | #include "rxglue.h" |
60 | #include "txport.h" |
61 | |
62 | /*----- Static variables --------------------------------------------------*/ |
63 | |
64 | static txport *tx = 0; |
65 | |
661c4bdc |
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 | |
2ec1e693 |
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) \ |
661c4bdc |
106 | _x->strptr = rx_alloc(_sz); \ |
2ec1e693 |
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 | |
661c4bdc |
254 | static APIRET APIENTRY rxfn_test(const char *fn, ULONG ac, RXSTRING *av, |
255 | const char *sn, RXSTRING *r) |
2ec1e693 |
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 | } |
661c4bdc |
271 | printf("tx = `%s'; f = `%s'; c = `%s'.\n", txname, txfile, txconf); |
2ec1e693 |
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 | |
661c4bdc |
283 | static APIRET APIENTRY rxfn_txname(const char *fn, ULONG ac, RXSTRING *av, |
284 | const char *sn, RXSTRING *r) |
2ec1e693 |
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 | |
661c4bdc |
299 | static APIRET APIENTRY rxfn_txfile(const char *fn, ULONG ac, RXSTRING *av, |
300 | const char *sn, RXSTRING *r) |
2ec1e693 |
301 | { |
302 | if (ac) |
303 | return (-1); |
304 | rxs_putf(r, "%s", txfile ? txfile : ""); |
305 | return (0); |
306 | } |
307 | |
661c4bdc |
308 | /* --- @txconf([CONFIG])@ --- |
2ec1e693 |
309 | * |
661c4bdc |
310 | * Arguments: @CONFIG@ = optional string to set |
2ec1e693 |
311 | * |
312 | * Returns: The currently-selected transport configuration string. |
313 | */ |
314 | |
661c4bdc |
315 | static APIRET APIENTRY rxfn_txconf(const char *fn, ULONG ac, RXSTRING *av, |
316 | const char *sn, RXSTRING *r) |
2ec1e693 |
317 | { |
661c4bdc |
318 | if (ac > 1) |
2ec1e693 |
319 | return (-1); |
661c4bdc |
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 | } |
2ec1e693 |
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 | |
661c4bdc |
348 | static APIRET APIENTRY rxfn_txinit(const char *fn, ULONG ac, RXSTRING *av, |
349 | const char *sn, RXSTRING *r) |
2ec1e693 |
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) { |
661c4bdc |
367 | rxs_get(&av[2], &dc); |
2ec1e693 |
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 | |
661c4bdc |
379 | /* --- @txsend(STRING, [OPTION])@ --- * |
2ec1e693 |
380 | * |
381 | * Arguments: @STRING@ = string to send |
661c4bdc |
382 | * @OPTION@ = `l' or `n' (for `linebreak' or `nolinebreak') |
2ec1e693 |
383 | * |
384 | * Returns: --- |
385 | * |
386 | * Use: Sends a string (exactly as written) to the transport. |
387 | */ |
388 | |
661c4bdc |
389 | static APIRET APIENTRY rxfn_txsend(const char *fn, ULONG ac, RXSTRING *av, |
390 | const char *sn, RXSTRING *r) |
2ec1e693 |
391 | { |
661c4bdc |
392 | if ((ac != 1 && ac != 2) || !tx || !av[0].strptr) |
2ec1e693 |
393 | return (-1); |
394 | tx_write(tx, av[0].strptr, av[0].strlength); |
661c4bdc |
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); |
2ec1e693 |
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 | |
661c4bdc |
413 | static APIRET APIENTRY rxfn_txrecv(const char *fn, ULONG ac, RXSTRING *av, |
414 | const char *sn, RXSTRING *r) |
2ec1e693 |
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 | |
661c4bdc |
442 | static APIRET APIENTRY rxfn_txeof(const char *fn, ULONG ac, RXSTRING *av, |
443 | const char *sn, RXSTRING *r) |
2ec1e693 |
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 | |
661c4bdc |
466 | static APIRET APIENTRY rxfn_txready(const char *fn, ULONG ac, RXSTRING *av, |
467 | const char *sn, RXSTRING *r) |
2ec1e693 |
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 | |
e9060e7e |
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 | |
af666e6f |
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 | |
2ec1e693 |
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 | |
661c4bdc |
647 | static APIRET APIENTRY rxfn_milliwait(const char *fn, ULONG ac, RXSTRING *av, |
648 | const char *sn, RXSTRING *r) |
2ec1e693 |
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[] = { |
661c4bdc |
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 }, |
e9060e7e |
677 | { "auplay", rxfn_auplay }, |
678 | { "aufetch", rxfn_aufetch }, |
af666e6f |
679 | { "aucache", rxfn_aucache }, |
e9060e7e |
680 | { "aunum", rxfn_aunum }, |
661c4bdc |
681 | { "milliwait", rxfn_milliwait }, |
2ec1e693 |
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); |
661c4bdc |
740 | argv = rx_alloc(ac * sizeof(*argv)); |
2ec1e693 |
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); |
661c4bdc |
747 | rc = RexxStart(ac, argv, name, prog, |
748 | "SYSTEM", RXSUBROUTINE, 0, &badrc, &res); |
2ec1e693 |
749 | if (rc) { |
661c4bdc |
750 | rx_free(RXSTRPTR(res)); |
751 | rx_free(argv); |
2ec1e693 |
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)); |
661c4bdc |
762 | rx_free(RXSTRPTR(res)); |
763 | rx_free(argv); |
2ec1e693 |
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 -------------------------------------------------*/ |