/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT * Copyright 1989 Massachusetts Institute of Technology */ /********************************************\ * * * WOOL_OBJECT Subr, FSubr, Expr and FExpr * * DEFINITIONS * * * \********************************************/ #ifndef INCLUDE_WL_FUNC_H #define INCLUDE_WL_FUNC_H /* type */ typedef struct _WOOL_Subr { WOOL_HEADER; int arity; WOOL_OBJECT(*body) (); } *WOOL_Subr; typedef struct _WOOL_FSubr { WOOL_HEADER; int arity; WOOL_OBJECT(*body) (); } *WOOL_FSubr; typedef struct _WOOL_Expr { WOOL_HEADER; int arity; WOOL_Atom *parameters; int body_size; WOOL_OBJECT *body; } *WOOL_Expr; typedef struct _WOOL_FExpr { WOOL_HEADER; int arity; WOOL_Atom *parameters; int body_size; WOOL_OBJECT *body; } *WOOL_FExpr; /* exported functions */ EXT WOOL_Subr WLSubr_make(); EXT WOOL_OBJECT wool_lambda_make(); EXT WOOL_OBJECT wool_lambdaq_make(); EXT WOOL_OBJECT defun(); EXT WOOL_OBJECT wool_subr_make(); EXT WOOL_OBJECT WLSubr_print(); EXT WOOL_OBJECT WLFSubr_print(); EXT WOOL_OBJECT WLExpr_print(); EXT WOOL_OBJECT WLFExpr_print(); EXT WOOL_OBJECT WLExpr_free(); EXT WOOL_OBJECT WLSubr_execute(); EXT WOOL_OBJECT WLFSubr_execute(); EXT WOOL_OBJECT WLExpr_execute(); EXT WOOL_OBJECT WLFExpr_execute(); EXT WOOL_OBJECT execute_local_code(); EXT WOOL_OBJECT local_variables(); EXT WOOL_OBJECT *map_eval(); /* methods */ EXT WOOL_METHOD WLSubr[] #ifdef DO_INIT = { (WOOL_METHOD) 0, /* METHODS_ARRAY */ WLNumber_eval, /* WOOL_eval 1 */ WLSubr_print, /* WOOL_print 2 */ WLNumber_free, /* WOOL_free 3 */ WLSubr_execute, /* WOOL_execute 4 */ wool_undefined_method_2, /* WOOL_set 5 */ (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */ wool_undefined_method_1, /* WOOL_open 7 */ wool_undefined_method_1, /* WOOL_close 8 */ wool_undefined_method_2, /* WOOL_process_event 9 */ wool_undefined_method_1, /* WOOL_copy 10 */ wool_undefined_method_2, /* WOOL_get_dimensions 11 */ wool_undefined_method_2, /* WOOL_draw 12 */ wool_undefined_method_2, /* WOOL_equal 13 */ wool_undefined_method_2, wool_undefined_method_2, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1 } #endif /* DO_INIT */ ; EXT WOOL_METHOD WLFSubr[] #ifdef DO_INIT = { (WOOL_METHOD) 0, /* METHODS_ARRAY */ WLNumber_eval, /* WOOL_eval 1 */ WLFSubr_print, /* WOOL_print 2 */ WLNumber_free, /* WOOL_free 3 */ WLFSubr_execute, /* WOOL_execute 4 */ wool_undefined_method_2, /* WOOL_set 5 */ (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */ wool_undefined_method_1, /* WOOL_open 7 */ wool_undefined_method_1, /* WOOL_close 8 */ wool_undefined_method_2, /* WOOL_process_event 9 */ wool_undefined_method_1, /* WOOL_copy 10 */ wool_undefined_method_2, /* WOOL_get_dimensions 11 */ wool_undefined_method_2, /* WOOL_draw 12 */ wool_undefined_method_2, /* WOOL_equal 13 */ wool_undefined_method_2, wool_undefined_method_2, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1 } #endif /* DO_INIT */ ; EXT WOOL_METHOD WLExpr[] #ifdef DO_INIT = { (WOOL_METHOD) 0, /* METHODS_ARRAY */ WLNumber_eval, /* WOOL_eval 1 */ WLExpr_print, /* WOOL_print 2 */ WLExpr_free, /* WOOL_free 3 */ WLExpr_execute, /* WOOL_execute 4 */ wool_undefined_method_2, /* WOOL_set 5 */ (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */ wool_undefined_method_1, /* WOOL_open 7 */ wool_undefined_method_1, /* WOOL_close 8 */ wool_undefined_method_2, /* WOOL_process_event 9 */ wool_undefined_method_1, /* WOOL_copy 10 */ wool_undefined_method_2, /* WOOL_get_dimensions 11 */ wool_undefined_method_2, /* WOOL_draw 12 */ wool_undefined_method_2, /* WOOL_equal 13 */ wool_undefined_method_2, wool_undefined_method_2, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1 } #endif /* DO_INIT */ ; EXT WOOL_METHOD WLFExpr[] #ifdef DO_INIT = { (WOOL_METHOD) 0, /* METHODS_ARRAY */ WLNumber_eval, /* WOOL_eval 1 */ WLFExpr_print, /* WOOL_print 2 */ WLExpr_free, /* WOOL_free 3 */ WLFExpr_execute, /* WOOL_execute 4 */ wool_undefined_method_2, /* WOOL_set 5 */ (WOOL_METHOD) wool_undefined_method_1,/* WOOL_get_C_value 6 */ wool_undefined_method_1, /* WOOL_open 7 */ wool_undefined_method_1, /* WOOL_close 8 */ wool_undefined_method_2, /* WOOL_process_event 9 */ wool_undefined_method_1, /* WOOL_copy 10 */ wool_undefined_method_2, /* WOOL_get_dimensions 11 */ wool_undefined_method_2, /* WOOL_draw 12 */ wool_undefined_method_2, /* WOOL_equal 13 */ wool_undefined_method_2, wool_undefined_method_2, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1, wool_undefined_method_1 } #endif /* DO_INIT */ ; /* A stack frame is: * - the (printable) expression which triggered the NEXT call * - a pointer to the previous stack frame * - size, the number of stored variables * - parameters, the list of formal (atoms, actives, pointers) parms * - new_values, the list of evaluated new values * - old_values, the list of previous values which will get restored * (internal space to the struct) */ typedef struct _WOOL_StackFrame { struct _WOOL_StackFrame *previous; /* previous stack frame */ int size; /* the number of stacked vars */ WOOL_Atom *parameters; /* pointer to parameters */ WOOL_OBJECT *new_values; /* pointer to new values */ WOOL_OBJECT old_values[1]; /* the old values to be restored */ } *WOOL_StackFrame; /* first frame and pointer to the last/current one */ EXT struct _WOOL_StackFrame wool_first_stackframe; EXT WOOL_StackFrame wool_current_stackframe INIT(&wool_first_stackframe); EXT WOOL_StackFrame wool_stackframe_on_error INIT(&wool_first_stackframe); /* call stack */ EXT WOOL_OBJECT *calling_function_stack; EXT WOOL_OBJECT *calling_function_current; EXT WOOL_OBJECT *calling_function_end; EXT int calling_function_on_error INIT(0); EXT int wool_max_stack_print_level INIT(100); #define calling_function_push(obj) \ if (calling_function_current >= calling_function_end) { \ int size = calling_function_end - calling_function_stack; \ int ptr = calling_function_current - calling_function_stack; \ calling_function_stack = (WOOL_OBJECT *) \ Realloc(calling_function_stack, \ size * 2 * sizeof(WOOL_OBJECT) - 4); \ calling_function_end = calling_function_stack +2*size -1; \ calling_function_current = calling_function_stack + ptr; \ } \ *calling_function_current++ = (WOOL_OBJECT) (obj); \ CheckLoopsPush() #ifdef DEBUG #define calling_function_pop() \ if (calling_function_current == calling_function_stack) \ wool_error("stack underflow%s", ""); \ calling_function_current--; \ CheckLoopsPop() #else /* DEBUG */ #define calling_function_pop() \ calling_function_current--; CheckLoopsPop() #endif /* DEBUG */ /* debug */ #ifdef DEBUG EXT int CheckLoopsN INIT(0); #define CheckLoopsPop() CheckLoopsN-- #ifdef COMMENT #define CheckLoopsPush() if (CheckLoopsN++ > 32000) \ wool_error("stack overflow%s", "") #else /* !COMMENT */ /* the above code is commented as it seems to trigger errors without reason */ #define CheckLoopsPush() CheckLoopsN++ #endif /* !COMMENT */ #else /* !DEBUG */ #define CheckLoopsPop() #define CheckLoopsPush() #endif/* !DEBUG */ #endif /* INCLUDE_WL_FUNC_H */