home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / wl_func.h < prev    next >
C/C++ Source or Header  |  1995-07-03  |  8KB  |  252 lines
  1. /* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
  2.  * Copyright 1989 Massachusetts Institute of Technology
  3.  */
  4. /********************************************\
  5. *                          *
  6. *  WOOL_OBJECT  Subr, FSubr, Expr and FExpr  *
  7. *  DEFINITIONS                     *
  8. *                          *
  9. \********************************************/
  10.  
  11. #ifndef INCLUDE_WL_FUNC_H
  12. #define INCLUDE_WL_FUNC_H
  13.  
  14. /* type */
  15.  
  16. typedef struct _WOOL_Subr {
  17.     WOOL_HEADER;
  18.     int             arity;
  19.     WOOL_OBJECT(*body) ();
  20. }              *WOOL_Subr;
  21.  
  22. typedef struct _WOOL_FSubr {
  23.     WOOL_HEADER;
  24.     int             arity;
  25.     WOOL_OBJECT(*body) ();
  26. }              *WOOL_FSubr;
  27.  
  28. typedef struct _WOOL_Expr {
  29.     WOOL_HEADER;
  30.     int             arity;
  31.     WOOL_Atom      *parameters;
  32.     int             body_size;
  33.     WOOL_OBJECT    *body;
  34. }              *WOOL_Expr;
  35.  
  36. typedef struct _WOOL_FExpr {
  37.     WOOL_HEADER;
  38.     int             arity;
  39.     WOOL_Atom      *parameters;
  40.     int             body_size;
  41.     WOOL_OBJECT    *body;
  42. }              *WOOL_FExpr;
  43.  
  44. /* exported functions */
  45.  
  46. EXT WOOL_Subr   WLSubr_make();
  47. EXT WOOL_OBJECT wool_lambda_make();
  48. EXT WOOL_OBJECT wool_lambdaq_make();
  49. EXT WOOL_OBJECT defun();
  50. EXT WOOL_OBJECT wool_subr_make();
  51. EXT WOOL_OBJECT WLSubr_print();
  52. EXT WOOL_OBJECT WLFSubr_print();
  53. EXT WOOL_OBJECT WLExpr_print();
  54. EXT WOOL_OBJECT WLFExpr_print();
  55. EXT WOOL_OBJECT WLExpr_free();
  56. EXT WOOL_OBJECT WLSubr_execute();
  57. EXT WOOL_OBJECT WLFSubr_execute();
  58. EXT WOOL_OBJECT WLExpr_execute();
  59. EXT WOOL_OBJECT WLFExpr_execute();
  60.  
  61. EXT WOOL_OBJECT execute_local_code();
  62. EXT WOOL_OBJECT local_variables();
  63. EXT WOOL_OBJECT *map_eval();
  64.  
  65. /* methods */
  66.  
  67. EXT WOOL_METHOD WLSubr[]
  68. #ifdef DO_INIT
  69. = {
  70.    (WOOL_METHOD) 0,        /* METHODS_ARRAY */
  71.    WLNumber_eval,        /* WOOL_eval 1 */
  72.    WLSubr_print,        /* WOOL_print 2 */
  73.    WLNumber_free,        /* WOOL_free 3 */
  74.    WLSubr_execute,        /* WOOL_execute 4 */
  75.    wool_undefined_method_2,        /* WOOL_set 5 */
  76.    (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */
  77.    wool_undefined_method_1,    /* WOOL_open 7 */
  78.    wool_undefined_method_1,    /* WOOL_close 8 */
  79.    wool_undefined_method_2,    /* WOOL_process_event 9 */
  80.    wool_undefined_method_1,    /* WOOL_copy 10 */
  81.    wool_undefined_method_2,    /* WOOL_get_dimensions 11 */
  82.    wool_undefined_method_2,    /* WOOL_draw 12 */
  83.    wool_undefined_method_2,    /* WOOL_equal 13 */
  84.    wool_undefined_method_2,
  85.    wool_undefined_method_2,
  86.    wool_undefined_method_1,
  87.    wool_undefined_method_1,
  88.    wool_undefined_method_1,
  89.    wool_undefined_method_1,
  90.    wool_undefined_method_1
  91. }
  92. #endif /* DO_INIT */
  93.                ;
  94.  
  95. EXT WOOL_METHOD WLFSubr[]
  96. #ifdef DO_INIT
  97. = {
  98.    (WOOL_METHOD) 0,        /* METHODS_ARRAY */
  99.    WLNumber_eval,        /* WOOL_eval 1 */
  100.    WLFSubr_print,        /* WOOL_print 2 */
  101.    WLNumber_free,        /* WOOL_free 3 */
  102.    WLFSubr_execute,        /* WOOL_execute 4 */
  103.    wool_undefined_method_2,        /* WOOL_set 5 */
  104.    (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */
  105.    wool_undefined_method_1,    /* WOOL_open 7 */
  106.    wool_undefined_method_1,    /* WOOL_close 8 */
  107.    wool_undefined_method_2,    /* WOOL_process_event 9 */
  108.    wool_undefined_method_1,    /* WOOL_copy 10 */
  109.    wool_undefined_method_2,    /* WOOL_get_dimensions 11 */
  110.    wool_undefined_method_2,    /* WOOL_draw 12 */
  111.    wool_undefined_method_2,    /* WOOL_equal 13 */
  112.    wool_undefined_method_2,
  113.    wool_undefined_method_2,
  114.    wool_undefined_method_1,
  115.    wool_undefined_method_1,
  116.    wool_undefined_method_1,
  117.    wool_undefined_method_1,
  118.    wool_undefined_method_1
  119. }
  120. #endif /* DO_INIT */
  121.                ;
  122.  
  123. EXT WOOL_METHOD WLExpr[]
  124. #ifdef DO_INIT
  125. = {
  126.    (WOOL_METHOD) 0,        /* METHODS_ARRAY */
  127.    WLNumber_eval,        /* WOOL_eval 1 */
  128.    WLExpr_print,        /* WOOL_print 2 */
  129.    WLExpr_free,            /* WOOL_free 3 */
  130.    WLExpr_execute,        /* WOOL_execute 4 */
  131.    wool_undefined_method_2,        /* WOOL_set 5 */
  132.    (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */
  133.    wool_undefined_method_1,    /* WOOL_open 7 */
  134.    wool_undefined_method_1,    /* WOOL_close 8 */
  135.    wool_undefined_method_2,    /* WOOL_process_event 9 */
  136.    wool_undefined_method_1,    /* WOOL_copy 10 */
  137.    wool_undefined_method_2,    /* WOOL_get_dimensions 11 */
  138.    wool_undefined_method_2,    /* WOOL_draw 12 */
  139.    wool_undefined_method_2,    /* WOOL_equal 13 */
  140.    wool_undefined_method_2,
  141.    wool_undefined_method_2,
  142.    wool_undefined_method_1,
  143.    wool_undefined_method_1,
  144.    wool_undefined_method_1,
  145.    wool_undefined_method_1,
  146.    wool_undefined_method_1
  147. }
  148. #endif /* DO_INIT */
  149.                ;
  150.  
  151. EXT WOOL_METHOD WLFExpr[]
  152. #ifdef DO_INIT
  153. = {
  154.    (WOOL_METHOD) 0,        /* METHODS_ARRAY */
  155.    WLNumber_eval,        /* WOOL_eval 1 */
  156.    WLFExpr_print,        /* WOOL_print 2 */
  157.    WLExpr_free,            /* WOOL_free 3 */
  158.    WLFExpr_execute,        /* WOOL_execute 4 */
  159.    wool_undefined_method_2,        /* WOOL_set 5 */
  160.    (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */
  161.    wool_undefined_method_1,    /* WOOL_open 7 */
  162.    wool_undefined_method_1,    /* WOOL_close 8 */
  163.    wool_undefined_method_2,    /* WOOL_process_event 9 */
  164.    wool_undefined_method_1,    /* WOOL_copy 10 */
  165.    wool_undefined_method_2,    /* WOOL_get_dimensions 11 */
  166.    wool_undefined_method_2,    /* WOOL_draw 12 */
  167.    wool_undefined_method_2,    /* WOOL_equal 13 */
  168.    wool_undefined_method_2,
  169.    wool_undefined_method_2,
  170.    wool_undefined_method_1,
  171.    wool_undefined_method_1,
  172.    wool_undefined_method_1,
  173.    wool_undefined_method_1,
  174.    wool_undefined_method_1
  175. }
  176. #endif /* DO_INIT */
  177.                ;
  178.  
  179.  
  180. /* A stack frame is:
  181.  * - the (printable) expression which triggered the NEXT call
  182.  * - a pointer to the previous stack frame
  183.  * - size, the number of stored variables
  184.  * - parameters, the list of formal (atoms, actives, pointers) parms
  185.  * - new_values, the list of evaluated new values
  186.  * - old_values, the list of previous values which will get restored
  187.  *         (internal space to the struct)
  188.  */
  189.  
  190. typedef struct _WOOL_StackFrame {
  191.     struct _WOOL_StackFrame *previous;    /* previous stack frame */
  192.     int             size;        /* the number of stacked vars */
  193.     WOOL_Atom      *parameters;        /* pointer to parameters */
  194.     WOOL_OBJECT    *new_values;        /* pointer to new values */
  195.     WOOL_OBJECT     old_values[1];    /* the old values to be restored */
  196. }               *WOOL_StackFrame;
  197.  
  198. /* first frame and pointer to the last/current one */
  199.  
  200. EXT struct _WOOL_StackFrame wool_first_stackframe;
  201. EXT WOOL_StackFrame wool_current_stackframe INIT(&wool_first_stackframe);
  202. EXT WOOL_StackFrame wool_stackframe_on_error INIT(&wool_first_stackframe);
  203.  
  204. /* call stack */
  205.  
  206. EXT WOOL_OBJECT *calling_function_stack;
  207. EXT WOOL_OBJECT *calling_function_current;
  208. EXT WOOL_OBJECT *calling_function_end;
  209. EXT int calling_function_on_error INIT(0);
  210. EXT int wool_max_stack_print_level INIT(100);
  211.  
  212. #define calling_function_push(obj) \
  213.     if (calling_function_current >= calling_function_end) { \
  214.     int size = calling_function_end - calling_function_stack; \
  215.     int ptr = calling_function_current - calling_function_stack; \
  216.     calling_function_stack = (WOOL_OBJECT *) \
  217.         Realloc(calling_function_stack, \
  218.             size * 2 * sizeof(WOOL_OBJECT) - 4); \
  219.     calling_function_end = calling_function_stack +2*size -1; \
  220.     calling_function_current = calling_function_stack + ptr; \
  221.     } \
  222.     *calling_function_current++ = (WOOL_OBJECT) (obj); \
  223.     CheckLoopsPush()
  224. #ifdef DEBUG
  225. #define calling_function_pop() \
  226.     if (calling_function_current == calling_function_stack) \
  227.     wool_error("stack underflow%s", ""); \
  228.     calling_function_current--; \
  229.     CheckLoopsPop()
  230. #else /* DEBUG */
  231. #define calling_function_pop() \
  232.     calling_function_current--; CheckLoopsPop()
  233. #endif /* DEBUG */
  234.  
  235. /* debug */
  236. #ifdef DEBUG
  237. EXT int CheckLoopsN INIT(0);
  238. #define CheckLoopsPop() CheckLoopsN--
  239. #ifdef COMMENT
  240. #define CheckLoopsPush() if (CheckLoopsN++ > 32000) \
  241.     wool_error("stack overflow%s", "")
  242. #else /* !COMMENT */
  243. /* the above code is commented as it seems to trigger errors without reason */
  244. #define CheckLoopsPush() CheckLoopsN++
  245. #endif /* !COMMENT */
  246. #else /* !DEBUG */
  247. #define CheckLoopsPop()
  248. #define CheckLoopsPush()
  249. #endif/* !DEBUG */
  250.  
  251. #endif /* INCLUDE_WL_FUNC_H */
  252.