/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
 * Copyright 1989 Massachusetts Institute of Technology
 */
/***************************\
* 			    *
*  various defs for wool   *
* 			    *
\***************************/

#ifndef INCLUDE_WOOL_H
#define INCLUDE_WOOL_H
#include <setjmp.h>
#ifndef EXT
#include "EXTERN.h"
#endif /* EXT */
#include "machine.h"

/* various parameters */

/*
 *  Maximum size for:
 *      length of name of CACHED objets (fonts, etc...)
 * 	output lines of wool_printf (not wool_puts)
 * 	file names (path look-up)
 * 	X properties (only "machine name" for now)
 *
 *  Should alway be >= 256, 1024 is fine.
 *  Used only for speed concerns to allocate temp strings in the stack
 */

#define MAX_TEMP_STRING_SIZE 1024

/* default WLPATH for searching wool files */

#ifdef INSTALL_PATH
#define DEFAULT_WLPATH INSTALL_PATH
#else /* INSTALL_PATH */
# ifdef INSTALL_DIR
#define DEFAULT_WLPATH INSTALL_DIR
# else 
#define DEFAULT_WLPATH DEFAULT_DEFAULT_WLPATH
# endif /* INSTALL_DIR */
#endif /* INSTALL_PATH */

/* path */

EXT	char *wool_path;
EXT     char *wool_user_profile_name, *wool_text_extension;

/* shell variables */

#define DEFAULT_FONT "fixed"		/* MUST exist! */

/* application_name */

EXT char *wool_application_NAME INIT(WOOL_APP_NAME);
EXT char *wool_application_name INIT(WOOL_APP_name);

/* END OF INSTALLATION PARAMETERS */

#ifndef Max
#define Max(x,y)		(((x)<(y))?(y):(x))
#define Min(x,y)		(((x)<(y))?(x):(y))
#ifndef Abs
#define Abs(x)			(((x)>0)?(x):-(x))
#endif
#define FlagOn(mask,flag) ((mask)&(flag))
#endif

/* Now, programmer's section... */

/* the WOOL_OBJECT type:
 * Each object handled by WOOL is a pointer to a structure including at least:
 *  - a pointer to a list of methods, common to all objects of this type.
 *  - a reference count, integer telling how many objects points to this
 *    one. The object should be freed as soon as this counter goes down to
 *    zero. (first bit is to see if it is not in the zrt, rest is for count)
 */

#ifndef DEBUG
#define WOOL_HEADER \
	struct _WOOL_OBJECT *(**type)(); \
	unsigned int reference_count
#else /* DEBUG */
#define WOOL_HEADER \
	struct _WOOL_OBJECT *(**type)(); \
	int reference_count
#endif /* DEBUG */

typedef struct _WOOL_OBJECT {
    WOOL_HEADER;
}               *WOOL_OBJECT;

typedef 
WOOL_OBJECT(*WOOL_METHOD) ();

typedef WOOL_METHOD *WOOL_TYPE;

/* wool_error prints the file and linenum of error... */

#ifdef DEBUG
#define wool_error(ERRstring,ERRmess) \
    (WOOL_OBJECT) (wool_printf("\nC source file \"%s\"", __FILE__), \
    wool_printf(" line %d\n", __LINE__), \
    _wool_error(ERRstring,ERRmess)) 
#if __STDC__
#define	ASSERT(p)   if (!(p)) wool_error("assertion failed: %s", #p)
#else /* __STDC__ */
#define	ASSERT(p)   if (!(p)) wool_error("assertion failed: %s", "p")
#endif /* __STDC__ */
#else
#define wool_error(s,m)	_wool_error(s,m)
#define	ASSERT(p)
#endif

/* global vars */

EXT int wool_error_status 		INIT(0);/* set to 1 by a wool_error */
EXT int wool_do_print_errors 		INIT(1);/* shall we print errors? */
EXT int wool_continue_reading_on_error 	INIT(0);/* in files */
EXT int wool_error_in_profile 		INIT(0);/* do we abort? */
EXT int wool_max_print_level 		INIT(9);/* max list imbrication */
EXT int wool_print_level 		INIT(0);/* current value */
EXT char *wool_shell_name		INIT(0);/* var name of forked shell */
EXT WOOL_OBJECT wool_host_name		INIT(0);/* host name running wool */

/* first include standards file if missing */

#ifndef NULL
#define NULL 0
#endif /* NULL */

/* to access easily any object's reference count */

#define REF(obj) (((WOOL_OBJECT) (obj))->reference_count)

/* Macros to ease initializations */

/* macro to define and initialize wool atoms in the code: 
 * 	type is WOOL_Atom or WOOL_OBJECT
 *	C_name is the name in the C code (i.e NIL)
 *	wool_value is the string which will represent the atom
 *	value is an object taken as the c_val
 */

#define wool_atom_make(type, C_name, wool_name, value) \
	C_name = (type) wool_atom(wool_name); \
	increase_reference(((WOOL_Atom) C_name)->c_val = (WOOL_OBJECT) value)

#define wool_atom_with_numeric_value_make(name, value) \
	WLAtom_set(wool_atom(name), WLNumber_make(value))

/* type-checking macros */

#define must_be_or_nil(typename, arg, n) \
    if (((WOOL_OBJECT) arg) != NIL && (arg) -> type != typename) 	\
    	bad_argument(arg, n, WOOL_TYPE_P_NAME(typename))

#define must_be(typename, object, n) \
    if (object -> type != typename) \
            bad_argument(object, n, WOOL_TYPE_P_NAME(typename))

/* get from context */

#define get_C_from_object(atom) \
	(long) WOOL_send(WOOL_get_C_value, (atom), ((atom)))

#define get_val_from_context(field, atom) \
	increase_reference((WOOL_OBJECT) (field = (void*) \
		WOOL_send(WOOL_eval, atom, (atom))))

#define get_bool_from_context(field, atom) \
	field = (WOOL_send(WOOL_eval, atom, (atom)) == NIL) ? 0 : 1

/* generic numerical type */
#ifdef PTR_TYPE
typedef PTR_TYPE Num;
#else /* PTR_TYPE */
typedef long Num;
#endif

#ifdef CARD32
typedef CARD32 Card32;
#else /* CARD32 */
typedef unsigned long	Card32;
#endif /* CARD32 */

/* for alignement problems, gives next valid pointer */
#define ALIGN(ptr) ((((ptr) >> 2) + 1) << 2)

#if defined(SYSV) || defined(SVR4)
#include <stdlib.h>
#define NO_MALLOC_DECLARE		/* since already done in stdlib.h */
#endif /* SYSV */

#ifndef NO_MALLOC_DECLARE
#ifdef VOID_MALLOC
extern void *malloc(), *realloc(), *calloc();
#else
extern char *malloc(), *realloc(), *calloc();
#endif
#endif

#ifndef DO_NOT_REDEFINE_MALLOC
#define Malloc(bytes) malloc(bytes)
#define Free(bytes) free(bytes)
#define Realloc(ptr, bytes) realloc(ptr, bytes)
#define Calloc(ptr, bytes) calloc(ptr, bytes)
#else /* DO_NOT_REDEFINE_MALLOC */
#define Malloc(bytes) wool_malloc(bytes)
#define Free(bytes) wool_free(bytes)
#define Realloc(ptr, bytes) wool_realloc(ptr, bytes)
#define Calloc(ptr, bytes) wool_calloc(ptr, bytes)
#ifdef VOID_MALLOC
extern void *wool_malloc(), *wool_realloc(), *wool_calloc();
#else
extern char *wool_malloc(), *wool_realloc(), *wool_calloc();
#endif

#endif /* DO_NOT_REDEFINE_MALLOC */

#ifdef USE_STANDARD_MALLOC
/* standard realloc might not like null pointers */
#undef Realloc
#define Realloc(ptr, bytes) ((ptr) ? realloc(ptr, bytes) : malloc(bytes))
#endif

#ifndef DEBUG
#define increase_reference(obj) REF(obj) += 2
#define decrease_reference(obj) {if(obj && (REF(obj)-=2)==1)zrt_put(obj);}
#define decrease_reference_non_null(obj) {if((REF(obj)-=2)==1)zrt_put(obj);}
#endif /* DEBUG */

#define dft_gc() while (dft_last > dft) Free(*(--dft_last))

/* exported functions */

EXT int		wool_init();
EXT WOOL_OBJECT _wool_error();
EXT WOOL_OBJECT wool_print();
EXT WOOL_OBJECT wool_subr_make();
EXT WOOL_OBJECT wool_eval();
EXT WOOL_OBJECT wool_read();
EXT int         wool_pool();
EXT WOOL_OBJECT NIL_FUNC();
EXT WOOL_OBJECT wool_type_or_evaluate();
EXT WOOL_OBJECT zrt_put();
EXT WOOL_OBJECT bad_argument();

/* exported objects */

EXT WOOL_OBJECT wool_read_expr INIT(NULL);
EXT WOOL_OBJECT temp_obj;

EXT WOOL_OBJECT  *zrt, *zrt_last;
EXT int     zrt_size, zrt_limit;

EXT char **dft, **dft_last, **dft_last_allocated;

EXT jmp_buf     wool_error_jmpbuf;
#ifdef NO_VOID
typedef int    *jmp_buf_ptr;	/* this works if jmp_buf is an int[] */
#else
typedef void    *jmp_buf_ptr;	/* this works if jmp_buf is an int[] */
#endif
EXT jmp_buf_ptr wool_goes_here_on_error 
INIT(wool_error_jmpbuf);

EXT WOOL_OBJECT NIL;		/* NIL is just a predefined atom */
EXT WOOL_OBJECT TRU;		/* t is just a predefined atom */
EXT WOOL_OBJECT QUOTE;		/* Function needed for parsing */
EXT WOOL_OBJECT UNDEFINED_WOOL_VALUE; /* for undefined value */
EXT WOOL_OBJECT WA_progn;	/* the progn atom */

#ifndef NULL
#define NULL 0
#endif /* NULL */

#define UNDEFINED (WOOL_OBJECT) 0
#define NARY	-1
#define ANY	-1

/*
 *  this macro is used to say where to go after an wool_error
 *  NOTE: be sure the function this macros is in won't have returned
 *  before the call to wool_error!
 */

#define set_wool_error_resume_point() (\
	calling_function_on_error = calling_function_current \
		- calling_function_stack, \
	wool_stackframe_on_error = wool_current_stackframe, \
	setjmp(wool_goes_here_on_error))

#define save_wool_error_resume_point() \
    int old_calling_function_on_error = calling_function_on_error; \
    WOOL_StackFrame old_wool_stackframe_on_error = wool_stackframe_on_error;\
    jmp_buf_ptr old_wool_goes_here_on_error = wool_goes_here_on_error;\
    jmp_buf         current_jmpbuf;\
    Trace('l',("Saving at %s:%d: buf [%d]\n",__FILE__,__LINE__,jmpbuf_checksum(wool_goes_here_on_error)));\
    wool_goes_here_on_error = current_jmpbuf


#define restore_wool_error_resume_point() \
    calling_function_on_error = old_calling_function_on_error; \
    wool_stackframe_on_error = old_wool_stackframe_on_error; \
    wool_goes_here_on_error = old_wool_goes_here_on_error ;\
    Trace('l',("Restoring at %s:%d: buf [%d]\n",__FILE__,__LINE__,jmpbuf_checksum(wool_goes_here_on_error)))

/*
 * error messages
 */

#define UNDEFINED_VARIABLE   0
#define BAD_NUMBER_OF_ARGS   1
#define UNDEFINED_FUNCTION   2
#define BAD_DEFUN 	     3
#define BAD_ARG_TYPE	     4
#define RELEASING_ATOM       5
#define BAD_LOCAL_SYNTAX     6
#define NOT_AN_ATOM	     7
#define SYNTAX_ERROR	     8
#define INTERNAL_ERROR	     9
#define TIME_EXCEEDED	    10
#define CANNOT_SET	    11
#define CANNOT_GET_C_VALUE  12
#define TOO_MANY_PARAMETERS 13
#define NON_WOOL_OBJECT	    14
#define UNDEFINED_METHOD    15
#define NO_MEMORY	    16
#define NOT_REDEFINABLE     17
#define SILENT_ERROR	    18
#define NOT_MODIFIABLE	    19
#define USER_ERROR          20    

/* the send define:
 * called by WOOL_send(WOOL_MethodName,
 *		       object,
 *		       (object, parm1, parm2, ... )); NEED parenthesises !!!
 */

#ifndef DEBUG
#define WOOL_send(message,object,parms) (*(((object)->type)[message]))parms
#else /* DEBUG */
#define WOOL_send(message,object,parms) \
    (WOOL_current_method = message, \
     wool_send_is_valid(message,object), \
	(WOOL_OBJECT) (*(((object)->type)[message]))parms)
#endif

#ifdef SECURE
extern char *wool_methods_names[];
#endif /* SECURE */

#define WOOL_TYPE_P_NAME(type) ((WOOL_Atom) (type)[0]) -> p_name

/* the methods for all WOOL types */

/*	method name          N arity desc */
#define WOOL_type_name	     0	/* 0 not a method but the atom of type name */
#define WOOL_eval 	     1	/* 1 evaluates object */
#define WOOL_print 	     2	/* 1 print object */
#define WOOL_free	     3	/* 1 release storage of object */
#define WOOL_execute 	     4	/* 2 execute (as CAR of list) */
#define WOOL_set	     5	/* 2 set value (called by setq) */
#define WOOL_get_C_value     6	/* 1 extract the raw pointed obj */
#define WOOL_open	     7	/* 1 create the X Window */
#define WOOL_close	     8	/* 1 destroy it */
#define WOOL_process_event   9	/* 2 trigger the event handler */
#define WOOL_copy	    10	/* 1 make a copy of itself */
#define WOOL_get_dimensions 11	/* 2 adjust and get dimensions */
#define WOOL_redraw	    12	/* 2 adjust and redraw an object */
#define WOOL_equal	    13	/* 2 a == b ? */
#define WOOL_reconfigure    14	/* 2 move after WOOL_redraw */
#define WOOL_setq	    15	/* 2 set but do not eval value */
#define WOOL_make	    16  /* 1 create a new object */
#define WOOL_silent_eval    17  /* 1 eval but do not break on undefined */

/* the undefined methods (aborts!), one per arity */

EXT WOOL_OBJECT wool_undefined_method_1();
EXT WOOL_OBJECT wool_undefined_method_2();

#ifdef DEBUG
EXT int WOOL_current_method;
#define FREED_MAGIC 0x31416	/* block has been freed */
#else
#define stop_if_in_dbx()
#endif /* DEBUG */

#define UndefinedPos	-1

/* the user-level debugging functions */

EXT int wool_tracing_on INIT(0);
EXT WOOL_OBJECT wool_tracing_on_EXPR INIT(0);
EXT int wool_tracing_level INIT(0);
EXT int wool_still_tracing INIT(0);

#if defined(__HIGHC__)
pragma on(POINTERS_COMPATIBLE);
#endif

/* debugging-only traces */

#ifdef DEBUG
EXT char * WlTraceFlags INIT("");
#define Trace(flag, args) if(strchr(WlTraceFlags, flag)) printf args
#define TraceDo(flag, inst) if(strchr(WlTraceFlags, flag)) inst
#else /* DEBUG */
#define Trace(flag, args)
#define TraceDo(flag, inst) 
#endif /* DEBUG */

/* no stats with USE_STANDARD_MALLOC */
#ifdef STATS
#ifdef USE_STANDARD_MALLOC
#undef STATS
#endif
#endif

#endif /* INCLUDE_WOOL_H */
