201 lines
4.5 KiB
C
201 lines
4.5 KiB
C
/**************************************\
|
|
* *
|
|
* main routines for wool interpreter *
|
|
* *
|
|
\**************************************/
|
|
|
|
#define WLPROFILE_USER_VARIABLE "WOOLPROFILE"
|
|
#define WLPATH_SHELL_VARIABLE "WOOLPATH"
|
|
|
|
#include <signal.h>
|
|
#include <stdio.h>
|
|
#include "EXTERN.h"
|
|
#include "wool.h"
|
|
#include "wl_atom.h"
|
|
#include "wl_coll.h"
|
|
#include "wl_func.h"
|
|
#include "wl_list.h"
|
|
#include "wl_number.h"
|
|
#include "wl_string.h"
|
|
#include "wl_pointer.h"
|
|
#include "wl_active.h"
|
|
#include "wl_name.h"
|
|
#include "yacc.h"
|
|
|
|
char *RCS_Header = /* the version */
|
|
"$Id: gwm.shar,v 1.115 1995/12/08 07:51:55 colas Exp $";
|
|
char buffer[8192]; /* input buffer */
|
|
|
|
WOOL_OBJECT wool_eval_expr;
|
|
DECLARE_strchr;
|
|
|
|
timeout_handler(); /* alarm handler */
|
|
#define MAX_DURATION 0 /* max time of an eval in seconds */
|
|
WOOL_Atom timeout; /* the wool atom "timeout" */
|
|
void wool_types_init();
|
|
|
|
main_init();
|
|
|
|
main(argc, argv)
|
|
int argc;
|
|
char *argv[];
|
|
|
|
{
|
|
char *s;
|
|
extern char *wool_fix_path();
|
|
/* option parsing */
|
|
|
|
wool_user_profile_name = ".woolrc";
|
|
wool_text_extension = ".wl";
|
|
|
|
print_banner();
|
|
/* initialize paths (put .:$HOME before built-ins) */
|
|
wool_path = wool_fix_path(DEFAULT_WLPATH);
|
|
if ((s = (char *) getenv(WLPROFILE_USER_VARIABLE)) && (s[0] != '\0'))
|
|
wool_user_profile_name = s;
|
|
if ((s = (char *) getenv(WLPATH_SHELL_VARIABLE)) && (s[0] != '\0'))
|
|
wool_path = s;
|
|
|
|
/* first, initialize wool */
|
|
wool_init(wool_types_init);
|
|
/* get the atoms we want */
|
|
timeout = wool_atom("timeout");
|
|
/* then tell it to go back here after an error */
|
|
set_wool_error_resume_point(); /* wool_error will jump here */
|
|
|
|
/* main routine: read/eval/print */
|
|
do {
|
|
/* initialize the input "pool" of wool */
|
|
wool_pool(NULL);
|
|
|
|
/*
|
|
* then we prompt the user until we think we have a complete
|
|
* expression (as we are told by the return code of wool_pool)
|
|
*/
|
|
do {
|
|
int i;
|
|
|
|
wool_puts("? ");
|
|
for (i = 0; i < 2 * wool_pool_parentheses_level; i++)
|
|
wool_putchar(' ');
|
|
if (!gets(buffer)) {
|
|
|
|
/*
|
|
* as we use wool_pool, we must take care of the end_of_file
|
|
* ourselves.
|
|
*/
|
|
wool_puts("Bye.\n");
|
|
exit(0);
|
|
}
|
|
} while (wool_pool(buffer));
|
|
|
|
/* so, now we can read/eval/print this pooled text
|
|
* add newline at the end for lex problems
|
|
*/
|
|
strcat(wool_pool_buffer, "\n");
|
|
wool_input_redirect(1, wool_pool_buffer, NULL, NULL);
|
|
|
|
|
|
/*
|
|
* we read all the expressions of this line, the NULL returned by
|
|
* wool_read meaning the end of the input (here the pool)
|
|
*/
|
|
while (wool_read()) {
|
|
/* we set the timeout for an eval to timeout */
|
|
alarm(timeout -> c_val ?
|
|
((WOOL_Number) (timeout -> c_val)) -> number
|
|
: MAX_DURATION);
|
|
if (wool_eval_expr = wool_eval(wool_read_expr)) {
|
|
wool_puts(" = ");
|
|
wool_print(wool_eval_expr);
|
|
wool_putchar('\n');
|
|
}
|
|
}
|
|
} while (1);
|
|
}
|
|
|
|
/*
|
|
* Test initialisations
|
|
*/
|
|
|
|
int variable = 8;
|
|
|
|
print_var()
|
|
{
|
|
printf("Var is %d\n", variable);
|
|
return NULL;
|
|
}
|
|
|
|
int (*fp)();
|
|
|
|
/* what to do when a wool-error occurs?
|
|
*/
|
|
|
|
wool_error_handler()
|
|
{
|
|
}
|
|
|
|
/* wool_end is exiting */
|
|
wool_end(n)
|
|
int n;
|
|
{
|
|
#ifdef MONITOR
|
|
moncontrol(0); /* do not trace ending code */
|
|
#endif /* MONITOR */
|
|
exit(n);
|
|
}
|
|
|
|
|
|
/* handler called by wool before execing a son after a fork
|
|
*/
|
|
|
|
wool_clean_before_exec()
|
|
{
|
|
}
|
|
|
|
char *
|
|
strchr_nth(s, c, n)
|
|
char *s, c;
|
|
int n;
|
|
{
|
|
while (s && n) {
|
|
s = strchr(s + 1, c);
|
|
n--;
|
|
}
|
|
return s;
|
|
}
|
|
|
|
print_banner()
|
|
{
|
|
char banner[128];
|
|
int banner_len = strchr_nth(RCS_Header, ' ', 4)
|
|
- strchr_nth(RCS_Header, ' ', 2) - 1;
|
|
|
|
strncpy(banner, strchr_nth(RCS_Header, ' ', 2) + 1, banner_len);
|
|
banner[banner_len] = '\0';
|
|
wool_printf("WOOL toplevel %s\n", banner);
|
|
}
|
|
|
|
/* you must initialize here all the used wool types in your application */
|
|
|
|
void
|
|
wool_types_init()
|
|
{
|
|
#define init_wool_type(type, name) type[0]=(WOOL_METHOD)wool_atom(name)
|
|
init_wool_type(WLActive, "active");
|
|
init_wool_type(WLAtom, "atom");
|
|
init_wool_type(WLCollection, "collection");
|
|
init_wool_type(WLQuotedExpr, "quoted-expr");
|
|
init_wool_type(WLSubr, "subr");
|
|
init_wool_type(WLFSubr, "fsubr");
|
|
init_wool_type(WLExpr, "expr");
|
|
init_wool_type(WLFExpr, "fexpr");
|
|
init_wool_type(WLList, "list");
|
|
init_wool_type(WLName, "name");
|
|
init_wool_type(WLNamespace, "namespace");
|
|
init_wool_type(WLNumber, "number");
|
|
init_wool_type(WLPointer, "pointer");
|
|
init_wool_type(WLString, "string");
|
|
#undef init_wool_type
|
|
}
|