Language/OS - Multiplatform Resource Library

home *** CD-ROM | disk | FTP | other *** search

/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / structs.h < prev next >

Wrap

C/C++ Source or Header | 1992-10-06 | 14.6 KB | 617 lines

/* ******************************************************************** */ /* structs.h Copyright (C) Codemist and University of Bath 1989 */ /* */ /* Basic definitions of tags and structures */ /* ******************************************************************** */ /* * Change Log: * Version 1, April 1989 * added a little support for classes RJB * hacked it about a bit KJP * added semaphores KJP */ #ifndef STRUCTS_H #define STRUCTS_H #include <stdio.h> #ifdef WITH_BIGNUMS #include "BigZ.h" #endif #undef BIGNUM #ifndef SETJMP_H #define SETJMP_H #include <setjmp.h> #endif /* Load system types... */ #include "system_t.h" /*#include "compact.h"*/ /* Primitive types... */ /* indiacte that ob can be swept */ /* note that the bignum typeof operation may need to be changed plus some comparisons in arith.c --- unless we do them right --- pab */ #define CALLABLE_TYPE 0x100 #define MACRO_TYPE 0x200 #define TYPE_UNUSED -1 #define TYPE_ENV 0xe0 #define TYPE_CONS 0x1 #define TYPE_CHAR (0x2) #define TYPE_STRING (0x3) #define TYPE_TABLE (0x5) #define TYPE_SYMBOL (0x6) #define TYPE_THREAD (0xb) #define TYPE_STREAM (0xc) #define TYPE_CLASS (0xd) #define TYPE_INSTANCE (0xe) #define TYPE_SPECIAL (0xf) #define TYPE_VECTOR 0x10 #define TYPE_INT (0x11) #define TYPE_RATIONAL (0x14) #define TYPE_FLOAT (0x15) #define TYPE_COMPLEX (0x16) #define TYPE_BIGNUM (0x17) #define TYPE_LASTNUMBER 0x2f #define TYPE_CONTINUE (0x30) #define TYPE_C_MODULE (0x40) #define TYPE_I_MODULE (0x50) #define TYPE_C_FUNCTION (0x60 | 0x100) #define TYPE_I_FUNCTION (0x61 | 0x100) #define TYPE_METHOD 0x62 #define TYPE_GENERIC (0x63 | 0x100) #define TYPE_C_MACRO (0x70 | 0x200) #define TYPE_I_MACRO (0x71 | 0x200) #define TYPE_SEMAPHORE (0x90) #define TYPE_LISTENER (0xa0) #define TYPE_SOCKET (0xa1) #define TYPE_NULL (0xb0) #define TYPE_WEAK_WRAPPER 0xc0 #define TYPE_B_FUNCTION (0x7a | 0x100) #define TYPE_B_MACRO (0x7b | 0x200) /* Plural Hacks */ /* ====== ===== */ #define TYPE_STRANGE (0xa5) /* Primitive accessors... */ #ifdef NOLOWTAGINTS #define typeof(p) ((p)->OBJECT.header.type) #define classof(p) ((p)->OBJECT.header.class) #else #define typeof(p) (((int)p) & 1 ? TYPE_INT: ((p)->OBJECT.header.type)) #define classof(p) (((int)p) & 1 ? Integer: ((p)->OBJECT.header.class)) #endif #define type_of(p) typeof(p) #define gcof(p) (((p)->OBJECT).header.gc) #define gc_of(p) gcof(p) #define lval_classof(p) ((p)->OBJECT.header.class) #define lval_typeof(p) ((p)->OBJECT.header.type) #define class_of(p) classof(p) /* Primitive type testers... */ #define is_cons(p) (typeof(p) == TYPE_CONS) #define is_char(p) (typeof(p) == TYPE_CHAR) #define is_string(p) (typeof(p) == TYPE_STRING) #define is_table(p) (typeof(p) == TYPE_TABLE) #define is_symbol(p) (typeof(p) == TYPE_SYMBOL) #define is_function(p) (typeof(p) & CALLABLE_TYPE) #define is_macro(p) (typeof(p) & MACRO_TYPE) #define is_module(p) ((typeof(p) == TYPE_I_MODULE) | \ (typeof(p) == TYPE_C_MODULE)) #define is_special(p) (typeof(p) == TYPE_SPECIAL) #define is_thread(p) (typeof(p) == TYPE_THREAD) #define is_stream(p) (typeof(p) == TYPE_STREAM) #ifdef NOLOWTAGINTS #define is_fixnum(p) (typeof(p) == TYPE_INT) #else #define is_fixnum(p) (((int) (p)) &1) #define mk_fixnum(x) ((LispObject) (((x)<<1) | 1)) #endif #define is_bignum(p) (typeof(p) == TYPE_BIGNUM) #define is_float(p) (typeof(p) == TYPE_FLOAT) #define is_vector(p) (typeof(p) == TYPE_VECTOR) #define is_continue(p) (typeof(p) == TYPE_CONTINUE) #define is_c_function(p) (typeof(p) == TYPE_C_FUNCTION) #define is_c_module(p) (typeof(p) == TYPE_C_MODULE) #define is_i_function(p) (typeof(p) == TYPE_I_FUNCTION) #define is_i_module(p) (typeof(p) == TYPE_I_MODULE) #define is_c_macro(p) (typeof(p) == TYPE_C_MACRO) #define is_i_macro(p) (typeof(p) == TYPE_I_MACRO) #define is_b_function(p) (typeof(p)==TYPE_B_FUNCTION) #define is_b_macro(p) (typeof(p) == TYPE_B_MACRO) #define is_semaphore(p) (typeof(p) == TYPE_SEMAPHORE) #define is_listener(p) (typeof(p) == TYPE_LISTENER) #define is_socket(p) (typeof(p) == TYPE_SOCKET) #define is_weak_wrapper(p) (typeof(p) == TYPE_WEAK_WRAPPER) #define is_e_function(p) (0) #define is_e_macro(p) (0) /* Other macros... */ #define null(p) ((LispObject)(p) == nil) #define consp(p) (is_cons(p) && (p) != nil) #define symbolp(p) (is_symbol(p) || (p) == nil) #define CAR(p) (((p)->CONS).car) #define CDR(p) (((p)->CONS).cdr) #define classp(p) (typeof(p) & 0x2000) #define is_number(p) (typeof(p) >= TYPE_INT && typeof(p) <= TYPE_LASTNUMBER) /* Evils for the garbage collector */ #define is_forwarded(x) \ (gcof(x))&0x1 #define forwardof(x) \ (classof(x)) #define set_forwarded(x, new) \ ( *(&gcof(x))|=1 , forwardof(x)=new) typedef union lispunion *LispObject; /* GC used object... */ struct hunk_structure { short type; short gc; LispObject next_hunk; int hunk_size; }; typedef struct Object_struct { short type; short gc; LispObject class; } Object_t; struct envobject { Object_t header; LispObject variable; LispObject value; struct envobject * next; LispObject mutable; }; typedef struct envobject *Env; /* the top most class object */ struct object_structure { Object_t header; LispObject slots[1]; /* the other slots */ }; struct integer_structure { Object_t header; int value_part; }; #ifdef NOLOWTAGINTS #define intval(x) ((x)->INT.value_part) #else #define intval(x) (((int)x)>>1) #endif /* low tag ints */ struct float_structure { Object_t header; double fvalue; }; struct bignum_structure { Object_t header; #ifdef WITH_BIGNUMS BigZ value; #endif int * bnum; }; struct complex_structure { Object_t header; LispObject real; LispObject imaginary; }; struct ratio_structure { Object_t header; LispObject numerator; LispObject denominator; }; struct character_structure { Object_t header; unsigned char font; unsigned char code; }; struct symbol_structure { Object_t header; LispObject lmodule; /* Module lookup cache for the interpreter */ LispObject lvalue; /* Part II */ LispObject gvalue; /* Dynamic global value */ LispObject plist; int hash; /* hash value cache */ char * pname; LispObject left; LispObject right; }; /* comparator is a equality function, defaulting to Fn_equal, * returning t or nil. */ struct table_structure { Object_t header; LispObject (*comparator)(LispObject*); LispObject lisp_comparator; LispObject tree; }; /* This one is an internal type, used by tables and arrays. * "base" is the first element in the array -- the others follow * on directly --- note that this comment is carp (anag) */ #ifdef notdef /* Thu Oct 17 14:49:31 1991 */ /**/ /**/#define vref(v,n) (*((v)->VECTOR.base + (n))) /**/#define vrefupdate(v,n,obj) (vref(v,n)=obj) #endif /* notdef Thu Oct 17 14:49:31 1991 */ #define vref(v,n) (*(&((v)->VECTOR.base) + (n))) #define vrefupdate(v,n,obj) (vref(v,n)=(obj)) struct vector_structure { Object_t header; int length; /* for now */ LispObject base; }; #ifdef WITH_SMALL_CONSES struct cons_structure { short type; short gc; LispObject car; LispObject cdr; }; #else struct cons_structure { Object_t header; LispObject car; LispObject cdr; }; #endif struct stream_structure { Object_t header; FILE* handle; LispObject name; int curchar; int mode; }; struct string_structure { Object_t header; int length; char value; /* really a c-string --- Should these be CHARs ?? */ }; #define stringof(x)\ (&((x)->STRING.value)) struct funcallable_object_structure { Object_t header; LispObject (*cfun)(); LispObject cfun_arg; }; struct continue_structure { Object_t header; LispObject value; /* Returned with... */ LispObject target; /* When bouncing unwind protects... */ LispObject thread; LispObject *gc_stack_pointer; /* Interpreter state */ Env dynamic_env; LispObject last_continue; LispObject handler_stack; LispObject dp; /* Elvira state */ /* Bytecode state? */ jmp_buf machine_state; int live; int unwind; }; struct thread_structure { Object_t header; LispObject* gc_stack_base; LispObject state; LispObject fun; LispObject args; LispObject value; LispObject parent; LispObject cochain; int status; int stack_size; int gc_stack_size; int* stack_base; }; struct semaphore_structure { Object_t header; SystemSemaphore semaphore; /* Just a hacked wrapper */ }; struct class_structure { Object_t header; LispObject name; /* Name of the class (NOT binding name) */ LispObject superclasses; /* Direct parents */ LispObject subclasses; /* Direct subclasses */ LispObject slot_table; /* Table of slot descriptions */ LispObject slot_list; /* Slot list */ LispObject direct_slot_list; /* Direct slot list */ LispObject precedence; /* Class precedence list */ #ifdef notdef /* Thu Oct 17 14:50:09 1991 */ /**/ LispObject prototype; /* Prototypical instance */ * #endif /* notdef Thu Oct 17 14:50:09 1991 */ int local_count; /* Number of local slots */ }; #define slotref(v,n) (*(&((v)->INSTANCE.slots) + (n))) #define slotrefupdate(v,n,obj) (slotref(v,n)=obj) struct instance_structure { Object_t header; LispObject slots; /* Some structure of data */ }; /* Functions... */ /* Special forms are compiler only and don't have homes (?) */ struct special_structure { Object_t header; LispObject name; Env env; LispObject (*func)(); }; /* Basic function template to which all conform */ struct function_structure { Object_t header; LispObject name; /* Original name in their module of origin */ LispObject home; /* Module of origin */ Env env; /* Defining parameter environment */ int argtype; /* Argument type code - unique for args */ }; struct c_function_structure { Object_t header; LispObject name; LispObject home; Env env; int argtype; LispObject (*func)(); /* Compiled functions just need fun pointer */ }; struct i_function_structure { Object_t header; LispObject name; LispObject home; Env env; int argtype; LispObject bvl; /* Parameter list */ LispObject body; /* Body forms */ }; /* Macros are a logical entity - being just specially interpretted functions */ struct generic_structure { Object_t header; LispObject name; LispObject home; Env env; /* Redundant, I think */ int argtype; LispObject method_class; LispObject discriminator; LispObject cache_table; LispObject method_table; /* Like it says */ }; /* Methods AREN'T FUNCTIONS ! */ struct method_structure { Object_t header; LispObject qualifier; /* Whatever that may be */ LispObject signature; /* Class list up to any n-ary bit */ LispObject host; /* Generic function ( nil => unatached ) */ LispObject function; /* The actual function */ LispObject fixed; /* Detatchable or not */ }; /* Module structures */ /* Template for all types - an abstract class like function */ struct module_structure { Object_t header; LispObject name; /* Symbol */ LispObject home; /* In ? */ LispObject imported_modules; /* Module dependecies - name list */ LispObject exported_names; /* Name list too */ LispObject bindings; }; struct c_module_structure { Object_t header; LispObject name; LispObject home; LispObject imported_modules; LispObject exported_names; LispObject bindings; LispObject* values; /* Value vector of static module */ LispObject (**functions)(); /* Function vector */ int entry_count; /* Useful thing */ }; typedef struct c_module_structure MODULE; struct i_module_structure { Object_t header; LispObject name; LispObject home; LispObject imported_modules; LispObject exported_names; LispObject bindings; int bounce_flag; }; /* Sockets support... */ #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS)) #include "syssockets.h" struct listener_structure { Object_t header; SocketHandle socket; SocketInName name; int state; }; struct socket_structure { Object_t header; SocketHandle socket; SocketInName name; char buffer[SOCKET_BUFFER_SIZE]; /* Input buffer */ int state; }; #endif /* Structure for extensiblility without hacking... */ struct c_object_structure { Object_t header; LispObject *slots; /* LispObject slot vector - garbage protected */ char first_c_byte; /* Start of C-data, unprotected */ }; /* Weak wrappers... */ struct weak_wrapper_structure { Object_t header; LispObject object; }; union lispunion { struct hunk_structure HUNK; struct object_structure OBJECT; struct integer_structure INT; struct float_structure FLOAT; struct bignum_structure BIGNUM; struct complex_structure COMPLEX; struct ratio_structure RATIO; struct character_structure CHAR; struct symbol_structure SYMBOL; struct table_structure TABLE; struct cons_structure CONS; struct stream_structure STREAM; struct string_structure STRING; struct thread_structure THREAD; struct semaphore_structure SEMAPHORE; struct class_structure CLASS; struct instance_structure INSTANCE; struct vector_structure VECTOR; struct continue_structure CONTINUE; struct envobject ENV; struct special_structure SPECIAL; struct function_structure FUNCTION; struct c_function_structure C_FUNCTION; struct i_function_structure I_FUNCTION; /** struct generic_structure GENERIC; */ struct function_structure MACRO; struct c_function_structure C_MACRO; struct i_function_structure I_MACRO; /** struct method_structure METHOD; */ struct module_structure MODULE; struct c_module_structure C_MODULE; struct i_module_structure I_MODULE; #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS)) struct listener_structure LISTENER; struct socket_structure SOCKET; #endif struct c_object_structure C_OBJECT; struct weak_wrapper_structure WEAK_WRAPPER; }; #include "system_p.h" #endif /* STRUCTS_H */ /* End of structs.h */