/* 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 #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 #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 */