252 lines
7.8 KiB
C
252 lines
7.8 KiB
C
/* 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 */
|