home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / main.c < prev    next >
C/C++ Source or Header  |  1995-07-03  |  5KB  |  201 lines
  1. /**************************************\
  2. *                        *
  3. *  main routines for wool interpreter  *
  4. *                        *
  5. \**************************************/
  6.  
  7. #define WLPROFILE_USER_VARIABLE "WOOLPROFILE"
  8. #define WLPATH_SHELL_VARIABLE   "WOOLPATH"
  9.  
  10. #include <signal.h>
  11. #include <stdio.h>
  12. #include "EXTERN.h"
  13. #include "wool.h"
  14. #include "wl_atom.h"
  15. #include "wl_coll.h"
  16. #include "wl_func.h"
  17. #include "wl_list.h"
  18. #include "wl_number.h"
  19. #include "wl_string.h"
  20. #include "wl_pointer.h"
  21. #include "wl_active.h"
  22. #include "wl_name.h"
  23. #include "yacc.h"
  24.  
  25. char    *RCS_Header =    /* the version */
  26. "$Id: gwm.shar,v 1.107 1995/07/03 09:24:22 colas Exp $";
  27. char            buffer[8192];    /* input buffer */
  28.  
  29. WOOL_OBJECT wool_eval_expr;
  30. DECLARE_strchr;
  31.  
  32. timeout_handler();        /* alarm handler */
  33. #define MAX_DURATION 0        /* max time of an eval in seconds */
  34. WOOL_Atom       timeout;    /* the wool atom "timeout" */
  35. void wool_types_init();
  36.  
  37. main_init();
  38.  
  39. main(argc, argv)
  40. int             argc;
  41. char           *argv[];
  42.  
  43. {
  44.     char *s;
  45.     extern char    *wool_fix_path();
  46.     /* option parsing */
  47.  
  48.     wool_user_profile_name = ".woolrc";
  49.     wool_text_extension = ".wl";
  50.  
  51.     print_banner();
  52.     /* initialize paths (put .:$HOME before built-ins) */
  53.     wool_path = wool_fix_path(DEFAULT_WLPATH);
  54.     if ((s = (char *) getenv(WLPROFILE_USER_VARIABLE)) && (s[0] != '\0'))
  55.     wool_user_profile_name = s;         
  56.     if ((s = (char *) getenv(WLPATH_SHELL_VARIABLE)) && (s[0] != '\0'))
  57.     wool_path = s;
  58.  
  59.     /* first, initialize wool */
  60.     wool_init(wool_types_init);
  61.     /* get the atoms we want */
  62.     timeout = wool_atom("timeout");
  63.     /* then tell it to go back here after an error */
  64.     set_wool_error_resume_point();    /* wool_error will jump here */
  65.  
  66.     /* main routine: read/eval/print */
  67.     do {
  68.     /* initialize the input "pool" of wool */
  69.     wool_pool(NULL);
  70.  
  71.     /*
  72.      * then we prompt the user until we think we have a complete
  73.      * expression (as we are told by the return code of wool_pool) 
  74.      */
  75.     do {
  76.         int             i;
  77.  
  78.         wool_puts("? ");
  79.         for (i = 0; i < 2 * wool_pool_parentheses_level; i++)
  80.         wool_putchar(' ');
  81.         if (!gets(buffer)) {
  82.  
  83.         /*
  84.          * as we use wool_pool, we must take care of the end_of_file
  85.          * ourselves. 
  86.          */
  87.         wool_puts("Bye.\n");
  88.         exit(0);
  89.         }
  90.     } while (wool_pool(buffer));
  91.  
  92.     /* so, now we can read/eval/print this pooled text 
  93.      * add newline at the end for lex problems
  94.      */
  95.     strcat(wool_pool_buffer, "\n");
  96.     wool_input_redirect(1, wool_pool_buffer, NULL, NULL);
  97.     
  98.  
  99.     /*
  100.      * we read all the expressions of this line, the NULL returned by
  101.      * wool_read meaning the end of the input (here the pool) 
  102.      */
  103.     while (wool_read()) {
  104.         /* we set the timeout for an eval to timeout */
  105.         alarm(timeout -> c_val ?
  106.           ((WOOL_Number) (timeout -> c_val)) -> number
  107.           : MAX_DURATION);
  108.         if (wool_eval_expr = wool_eval(wool_read_expr)) {
  109.         wool_puts(" = ");
  110.         wool_print(wool_eval_expr);
  111.         wool_putchar('\n');
  112.         }
  113.     }
  114.     } while (1);
  115. }
  116.  
  117. /*
  118.  * Test initialisations
  119.  */
  120.  
  121. int variable = 8;
  122.  
  123. print_var()
  124. {
  125.     printf("Var is %d\n", variable);
  126.     return NULL;
  127. }
  128.  
  129. int (*fp)();
  130.  
  131. /* what to do when a wool-error occurs?
  132.  */
  133.  
  134. wool_error_handler()
  135. {
  136. }
  137.  
  138. /* wool_end is exiting */
  139. wool_end(n)
  140. int n;
  141. {
  142. #ifdef MONITOR
  143.     moncontrol(0);            /* do not trace ending code */
  144. #endif /* MONITOR */
  145.     exit(n);
  146. }
  147.  
  148.  
  149. /* handler called by wool before execing a son after a fork
  150.  */
  151.  
  152. wool_clean_before_exec()
  153. {
  154. }
  155.  
  156. char *
  157. strchr_nth(s, c, n)
  158. char *s, c;
  159. int n;
  160. {
  161.     while (s && n) {
  162.     s = strchr(s + 1, c);
  163.     n--;
  164.     }
  165.     return s;
  166. }
  167.  
  168. print_banner()
  169. {
  170.     char banner[128];
  171.     int banner_len = strchr_nth(RCS_Header, ' ', 4)
  172.     - strchr_nth(RCS_Header, ' ', 2) - 1;
  173.  
  174.     strncpy(banner, strchr_nth(RCS_Header, ' ', 2) + 1, banner_len);
  175.     banner[banner_len] = '\0';
  176.     wool_printf("WOOL toplevel %s\n", banner);
  177. }
  178.  
  179. /* you must initialize here all the used wool types in your application */
  180.  
  181. void
  182. wool_types_init()
  183. {
  184. #define init_wool_type(type, name) type[0]=(WOOL_METHOD)wool_atom(name)
  185.     init_wool_type(WLActive, "active");
  186.     init_wool_type(WLAtom, "atom");
  187.     init_wool_type(WLCollection, "collection");
  188.     init_wool_type(WLQuotedExpr, "quoted-expr");
  189.     init_wool_type(WLSubr, "subr");
  190.     init_wool_type(WLFSubr, "fsubr");
  191.     init_wool_type(WLExpr, "expr");
  192.     init_wool_type(WLFExpr, "fexpr");
  193.     init_wool_type(WLList, "list");
  194.     init_wool_type(WLName, "name");
  195.     init_wool_type(WLNamespace, "namespace");
  196.     init_wool_type(WLNumber, "number");
  197.     init_wool_type(WLPointer, "pointer");
  198.     init_wool_type(WLString, "string");
  199. #undef init_wool_type
  200. }
  201.