3 * $Id: rxglue.c,v 1.1 2002/01/25 19:34:45 mdw Exp $
5 * REXX glue for C core functionality
7 * (c) 2001 Mark Wooding
10 /*----- Licensing notice --------------------------------------------------*
12 * This file is part of Jog: Programming for a jogging machine.
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.
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.
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.
29 /*----- Revision history --------------------------------------------------*
32 * Revision 1.1 2002/01/25 19:34:45 mdw
37 /*----- Header files ------------------------------------------------------*/
52 #include <sys/types.h>
57 #define RX_STRONGTYPING
60 #include <mLib/alloc.h>
61 #include <mLib/dstr.h>
67 /*----- Static variables --------------------------------------------------*/
69 static txport
*tx
= 0;
71 /*----- Conversion functions ----------------------------------------------*/
73 /* --- @rxs_putm@ --- *
75 * Arguments: @RXSTRING *x@ = pointer to REXX string structure
77 * @const void *p@ = pointer to data block
78 * @size_t sz@ = size of data
80 * @const dstr *d@ = pointer to source string
81 * For @rxs_putf@ and @rxs_vputf@:
82 * @const char *m@ = message format string
86 * Use: Stashes some text in an @RXSTRING@, overwriting whatever was
87 * there before. We assume that the previous contents don't
91 #define RXS_PUTM(x, p, sz) do { \
93 const void *_p = (p); \
95 if (!_x->strptr || _x->strlength < _sz) \
96 _x->strptr = xmalloc(_sz); \
97 memcpy(_x->strptr, _p, _sz); \
98 _x->strlength = _sz; \
101 static void rxs_putm(RXSTRING
*x
, const void *p
, size_t sz
)
106 #define RXS_PUTD(x, d) do { \
108 RXS_PUTM((x), _d->buf, _d->len); \
111 static void rxs_putd(RXSTRING
*x
, dstr
*d
) { RXS_PUTD(x
, d
); }
113 static void rxs_vputf(RXSTRING
*x
, const char *m
, va_list *ap
)
116 dstr_vputf(&d
, m
, ap
);
121 static void rxs_putf(RXSTRING
*x
, const char *m
, ...)
126 dstr_vputf(&d
, m
, &ap
);
132 /* --- @rxs_get@ --- *
134 * Arguments: @const RXSTRING *x@ = pointer to a REXX string
135 * @dstr *d@ = where to put it
139 * Use: Pulls a REXX string out and puts it in a dynamic string.
142 #define RXS_GET(x, d) do { \
143 const RXSTRING *_x = (x); \
145 DPUTM(_dd, _x->strptr, _x->strlength); \
149 static void rxs_get(const RXSTRING
*x
, dstr
*d
) { RXS_GET(x
, d
); }
151 /* --- @rxs_tol@ --- *
153 * Arguments: @const RXSTRING *x@ = pointer to a REXX string
154 * @long *ii@ = where to put the answer
156 * Returns: Zero on success, or nonzero on error.
158 * Use: Fetches an integer from a REXX string. This doesn't cope
159 * with multiprecision integers or similar silliness.
162 static int rxs_tol(const RXSTRING
*x
, long *ii
)
165 const char *p
= x
->strptr
, *l
= p
+ x
->strlength
;
171 #define MINR (LONG_MIN/10)
172 #define MIND (LONG_MIN%10)
174 while (p
< l
&& isspace((unsigned char)*p
))
180 else if (*p
== '-') {
184 while (p
< l
&& isspace((unsigned char)*p
))
186 while (p
< l
&& isdigit((unsigned char)*p
)) {
188 if (i
< MINR
|| (i
== MINR
&& -j
< MIND
))
193 while (p
< l
&& isspace((unsigned char)*p
))
195 if (p
< l
|| !(f
& f_ok
))
212 /* --- @rxs_block@ --- *
214 * Arguments: @const RXSTRING *x@ = a REXX string
215 * @unsigned long *t@ = where to put the block spec
217 * Returns: Zero if OK, nonzero on error.
219 * Use: Picks out a blockingness spec.
222 static int rxs_block(const RXSTRING
*x
, unsigned long *t
)
226 if (!x
->strptr
|| x
->strlength
< 1)
228 switch (x
->strptr
[0]) {
234 if (rxs_tol(x
, &i
) || i
< 0)
242 /*----- REXX functions ----------------------------------------------------*/
244 static APIRET APIENTRY
rxfn_test(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
245 char *sn
, RXSTRING
*r
)
249 printf("test entry\n"
251 for (i
= 0; i
< ac
; i
++) {
254 printf(" av[%lu] = `", i
);
255 fwrite(av
[i
].strptr
, 1, av
[i
].strlength
, stdout
);
256 if (rxs_tol(&av
[i
], &l
))
259 printf("' (%ld)\n", l
);
261 printf("tx = `%s'; f = `%s'; c = `%s'.", txname
, txfile
, txconf
);
262 rxs_putf(r
, "function `%s' completed ok", fn
);
266 /* --- @txname()@ ---
270 * Returns: The currently-selected transport name.
273 static APIRET APIENTRY
rxfn_txname(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
274 char *sn
, RXSTRING
*r
)
278 rxs_putf(r
, "%s", txname
);
282 /* --- @txfile()@ ---
286 * Returns: The currently-selected transport filename.
289 static APIRET APIENTRY
rxfn_txfile(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
290 char *sn
, RXSTRING
*r
)
294 rxs_putf(r
, "%s", txfile ? txfile
: "");
298 /* --- @txfile()@ ---
302 * Returns: The currently-selected transport configuration string.
305 static APIRET APIENTRY
rxfn_txconf(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
306 char *sn
, RXSTRING
*r
)
310 rxs_putf(r
, "%s", txconf ? txconf
: "");
314 /* --- @txinit([NAME], [FILE], [CONFIG])@ ---
316 * Arguments: @NAME@ = transport name to select
317 * @FILE@ = transport filename
318 * @CONFIG@ = transport configuration string
322 * Use: Initializes a transport using the given settings. Omitted
323 * arguments are filled in from the command line, or internal
327 static APIRET APIENTRY
rxfn_txinit(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
328 char *sn
, RXSTRING
*r
)
330 const char *n
= txname
, *f
= txfile
, *c
= txconf
;
331 dstr dn
= DSTR_INIT
, df
= DSTR_INIT
, dc
= DSTR_INIT
;
337 if (ac
>= 1 && av
[0].strptr
) {
338 rxs_get(&av
[0], &dn
);
341 if (ac
>= 2 && av
[1].strptr
) {
342 rxs_get(&av
[1], &df
);
345 if (ac
>= 3 && av
[2].strptr
) {
346 rxs_get(&av
[2], &dn
);
349 tx
= tx_create(n
, f
, c
);
358 /* --- @txsend(STRING)@ --- *
360 * Arguments: @STRING@ = string to send
364 * Use: Sends a string (exactly as written) to the transport.
367 static APIRET APIENTRY
rxfn_txsend(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
368 char *sn
, RXSTRING
*r
)
370 if (ac
!= 1 || !tx
|| !av
[0].strptr
)
372 tx_write(tx
, av
[0].strptr
, av
[0].strlength
);
376 /* --- @txrecv([MILLIS])@ --- *
378 * Arguments: @MILLIS@ = how long (in milliseconds) to wait, or `forever'
380 * Returns: The string read (may be null if nothing available -- sorry).
382 * Use: Reads the next line from the transport. If @MILLIS@ is an
383 * integer, then give up after that many milliseconds of
384 * waiting; if it is `forever' (or anything beginning with an
385 * `f') then don't give up. The default is to wait forever.
388 static APIRET APIENTRY
rxfn_txrecv(unsigned char *fn
, ULONG ac
, RXSTRING
*av
,
389 char *sn
, RXSTRING
*r
)
392 unsigned long t
= FOREVER
;
396 if (ac
>= 1 && rxs_block(&av
[0], &t
))
403 rxs_putm(r
, l
->s
, l
->len
);
409 /* --- @TXEOF()@ --- *
413 * Returns: True if end-of-file has been seen on the transport, otherwise
417 static APIRET APIENTRY
rxfn_txeof(unsigned char *fn
, ULONG ac
,
418 RXSTRING
*av
, char *sn
, RXSTRING
*r
)
422 rxs_putf(r
, "%d", tx
->s
== TX_CLOSED
&& !tx
->ll
);
426 /* --- @txready([MILLIS])@ --- *
428 * Arguments: @MILLIS@ = how long (in milliseconds) to wait, or `forever'
430 * Returns: True if a line is ready, otherwise false.
432 * Use: Returns whether the transport is ready for reading. If
433 * @MILLIS@ is an integer, then wait for at most that many
434 * milliseconds before returning. If @MILLIS@ is `forever' (or
435 * anything beginning with `f') then wait forever for
436 * readiness. This isn't useless: it can trip the end-of-file
437 * detector. If @MILLIS@ is omitted, return immediately (as if
438 * 0 had been specified).
441 static APIRET APIENTRY
rxfn_txready(unsigned char *fn
, ULONG ac
,
442 RXSTRING
*av
, char *sn
, RXSTRING
*r
)
448 if (ac
>= 1 && rxs_block(&av
[0], &t
))
450 rxs_putf(r
, "%d", !!tx_read(tx
, t
));
454 /* --- @MILLIWAIT(MILLIS)@ --- *
456 * Arguments: @MILLIS@ = how long (in milliseconds) to wait
460 * Use: Waits for @MILLIS@ milliseconds. Always.
463 static APIRET APIENTRY
rxfn_milliwait(unsigned char *fn
, ULONG ac
,
464 RXSTRING
*av
, char *sn
, RXSTRING
*r
)
469 if (ac
!= 1 || !av
[0].strptr
)
471 if (rxs_tol(&av
[0], &l
) || l
< 0)
473 tv
.tv_sec
= l
/ 1000;
474 tv
.tv_usec
= (l
% 1000) * 1000;
475 select(0, 0, 0, 0, &tv
);
479 /*----- Initialization ----------------------------------------------------*/
481 struct rxfntab
{ char *name
; RexxFunctionHandler
*fn
; };
483 static const struct rxfntab rxfntab
[] = {
484 { "test", rxfn_test
},
485 { "txname", rxfn_txname
},
486 { "txfile", rxfn_txfile
},
487 { "txconf", rxfn_txconf
},
488 { "txinit", rxfn_txinit
},
489 { "txsend", rxfn_txsend
},
490 { "txrecv", rxfn_txrecv
},
491 { "txeof", rxfn_txeof
},
492 { "txready", rxfn_txready
},
493 { "milliwait", rxfn_milliwait
},
497 /* --- @rx_init@ --- *
503 * Use: Initializes the REXX external functions.
508 const struct rxfntab
*f
;
511 for (f
= rxfntab
; f
->fn
; f
++) {
512 if ((rc
= RexxRegisterFunctionExe(f
->name
, f
->fn
)) != 0) {
513 err_report(ERR_RXGLUE
, ERRRX_INIT
, rc
,
514 "couldn't register function `%s' (code %d)", f
->name
, rc
);
520 /*----- Running REXX programs ---------------------------------------------*/
522 /* --- @rx_run@ --- *
524 * Arguments: @const char *name@ = pointer to filename (or null)
525 * @const void *p@ = pointer to program text
526 * @size_t sz@ = size of program text
527 * @int ac@ = number of arguments
528 * @const char *const *av@ = vector of command-line arguments
530 * Returns: Exit code from program.
532 * Use: Runs a REXX script from memory.
535 int rx_run(const char *name
, const void *p
, size_t sz
,
536 int ac
, const char *const *av
)
546 /* --- Set things up --- */
550 MAKERXSTRING(prog
[0], (void *)p
, sz
);
551 MAKERXSTRING(prog
[1], 0, 0);
552 argv
= xmalloc(ac
* sizeof(*argv
));
553 for (i
= 0; i
< ac
; i
++)
554 MAKERXSTRING(argv
[i
], (char *)av
[i
], strlen(av
[i
]));
556 /* --- Run the script --- */
558 MAKERXSTRING(res
, 0, 0);
559 rc
= RexxStart(ac
, argv
, (char *)name
, prog
,
560 "CMD", RXCOMMAND
, 0, &badrc
, &res
);
564 err_report(ERR_RXERR
, 0, -rc
, "rexx error from script `%s'", name
);
566 err_report(ERR_RXGLUE
, ERRRX_INTERP
, rc
, "intepreter internal error");
570 /* --- Pick apart the results --- */
572 dstr_putm(&d
, RXSTRPTR(res
), RXSTRLEN(res
));
580 /* --- @rx_runfile@ --- *
582 * Arguments: @const char *name@ = pointer to filename
583 * @int ac@ = number of command-line arguments
584 * @const char *const *av@ = vector of command-line arguments
586 * Returns: Exit code from program.
588 * Use: Runs a REXX script from a file, given its name.
591 int rx_runfile(const char *name
, int ac
, const char *const *av
)
599 /* --- Read the file into memory --- *
601 * This way avoids any crapness in the REXX implementation and means we can
602 * report errors in a more sensible way.
605 if ((fp
= fopen(name
, "r")) == 0)
608 n
= fread(buf
, 1, sizeof(buf
), fp
);
610 } while (n
== sizeof(buf
));
615 /* --- Now do the from-memory thing --- */
617 rc
= rx_run(name
, d
.buf
, d
.len
, ac
, av
);
621 /* --- Tidy up on errors --- */
627 err_report(ERR_RXGLUE
, ERRRX_SCRIPTREAD
, errno
,
628 "couldn't read script `%s': %s", name
, strerror(errno
));
632 /*----- That's all, folks -------------------------------------------------*/