/* $Header$ */ /* * Copyright © 1988-2004 Keith Packard and Bart Massey. * All Rights Reserved. See the file COPYING in this directory * for licensing information. */ /* * value.h * * type definitions for functions returning values */ #ifndef _VALUE_H_ #define _VALUE_H_ #include #include #include #include #include #include #include #include typedef enum { False = 0, True = 1 } Bool; typedef char *Atom; #ifndef MEM_TRACE typedef const struct _valueType ValueRep; #else typedef struct _valueType ValueRep; #endif typedef struct _box *BoxPtr; typedef union _code *CodePtr; typedef struct _frame *FramePtr; typedef struct _thread *ThreadPtr; typedef struct _continuation *ContinuationPtr; typedef union _value *Value; typedef struct _obj *ObjPtr; typedef union _inst *InstPtr; typedef union _symbol *SymbolPtr; extern Atom AtomId (char *name); #define AtomName(a) (a) extern int AtomInit (void); typedef struct _AtomList *AtomListPtr; typedef union _type *TypePtr; typedef struct _structType *StructTypePtr; typedef union _expr *ExprPtr; typedef struct _catch *CatchPtr; typedef struct _twixt *TwixtPtr; typedef struct _jump *JumpPtr; typedef struct _AtomList { DataType *data; AtomListPtr next; Atom atom; } AtomList; AtomListPtr NewAtomList (AtomListPtr next, Atom atom); /* * computational radix for natural numbers. Make sure the * definitions for digit, double_digit and signed_digit will * still work correctly. */ #if HAVE_STDINT_H # include #define PtrToInt(p) ((int) (intptr_t) (p)) #define PtrToUInt(p) ((unsigned) (uintptr_t) (p)) #define IntToPtr(i) ((void *) (intptr_t) (i)) #define UIntToPtr(u) ((void *) (uintptr_t) (u)) # if HAVE_UINT64_T /* * If stdint.h defines a 64 bit datatype, use 32 bit * chunks */ # define DIGITBITS 32 typedef uint64_t double_digit; typedef int64_t signed_digit; typedef uint32_t digit; # else # define DIGITBITS 16 typedef uint32_t double_digit; typedef uint16_t digit; typedef int32_t signed_digit; # endif #else #define PtrToInt(p) ((int) (p)) #define PtrToUInt(p) ((unsigned) (p)) #define IntToPtr(i) ((void *) (i)) #define UIntToPtr(u) ((void *) (u)) # if SIZEOF_UNSIGNED_LONG_LONG == 8 || SIZEOF_UNSIGNED_LONG == 8 # define DIGITBITS 32 # else # define DIGITBITS 16 # endif # if DIGITBITS == 32 # if SIZEOF_UNSIGNED_LONG_LONG == 8 typedef unsigned long long double_digit; typedef long long signed_digit; # else # if SIZEOF_UNSIGNED_LONG == 8 typedef unsigned long double_digit; typedef long signed_digit; # endif # endif # if SIZEOF_UNSIGNED_LONG == 4 typedef unsigned long digit; # else # if SIZEOF_UNSIGNED_INT == 4 typedef unsigned int digit; # endif # endif # else # if SIZEOF_UNSIGNED_LONG == 4 typedef unsigned long double_digit; typedef long signed_digit; # else # if SIZEOF_UNSIGNED_INT == 4 typedef unsigned int double_digit; typedef int signed_digit; # endif # endif # if SIZEOF_UNSIGNED_INT == 2 typedef unsigned int digit; # else # if SIZEOF_UNSIGNED_SHORT == 2 typedef unsigned short digit; # endif # endif # endif #endif #define MAXDIGIT ((digit) (BASE - 1)) #if DIGITBITS == 32 # define BASE ((double_digit) 65536 * (double_digit) 65536) # define LBASE2 32 # define LLBASE2 5 #else # define BASE ((double_digit) 65536) # define LBASE2 16 # define LLBASE2 4 #endif #define TwoDigits(n,i) ((double_digit) NaturalDigits(n)[i-1] | \ ((double_digit) NaturalDigits(n)[i] << LBASE2)) #define ModBase(t) ((t) & (((double_digit) 1 << LBASE2) - 1)) #define DivBase(t) ((t) >> LBASE2) /* HashValues are stored in rep_int */ typedef int HashValue; /* * Natural numbers form the basis for both the Integers and Rationals, * but needn't ever be exposed to the user */ typedef struct _natural { DataType *type; int length; } Natural; #define NaturalLength(n) ((n)->length) #define NaturalDigits(n) ((digit *) ((n) + 1)) Natural *NewNatural (unsigned value); Natural *NewDoubleDigitNatural (double_digit dd); Natural *AllocNatural (int size); Bool NaturalEqual (Natural *, Natural *); Bool NaturalLess (Natural *, Natural *); Natural *NaturalPlus (Natural *, Natural *); Natural *NaturalMinus (Natural *, Natural *); Natural *NaturalTimes (Natural *, Natural *); Natural *NaturalLand (Natural *, Natural *); Natural *NaturalLor (Natural *, Natural *); Natural *NaturalCompliment (Natural *, int len); Natural *NaturalNegate (Natural *, int len); Natural *NaturalDivide (Natural *a, Natural *b, Natural **remp); Natural *NaturalGcd (Natural *a, Natural *b); char *NaturalSprint (char *, Natural *, int base, int *width); Natural *NaturalSqrt (Natural *); Natural *NaturalFactor (Natural *n, Natural *max); Natural *NaturalIntPow (Natural *n, int p); Natural *NaturalPow (Natural *n, Natural *); Natural *NaturalPowMod (Natural *n, Natural *p, Natural *m); Natural *NaturalRsl (Natural *v, int shift); Natural *NaturalLsl (Natural *v, int shift); Natural *NaturalMask (Natural *v, int bits); int NaturalPowerOfTwo (Natural *v); int NaturalEstimateLength (Natural *, int base); void NaturalCopy (Natural *, Natural *); Bool NaturalZero (Natural *); Bool NaturalEven (Natural *); void NaturalDigitMultiply (Natural *a, digit i, Natural *result); digit NaturalSubtractOffset (Natural *a, Natural *b, int offset); digit NaturalSubtractOffsetReverse (Natural *a, Natural *b, int offset); Bool NaturalGreaterEqualOffset (Natural *a, Natural *b, int offset); void NaturalAddOffset (Natural *a, Natural *b, int offset); Natural *NaturalBdivmod (Natural *u_orig, Natural *v); Natural *NaturalKaryReduction (Natural *u_orig, Natural *v); int NaturalWidth (Natural *u); digit DigitBmod (digit u, digit v, int s); int IntWidth (int i); int DoubleDigitWidth (double_digit i); HashValue NaturalHash (Natural *a); extern Natural *max_int_natural; extern Natural *zero_natural; extern Natural *one_natural; extern Natural *two_natural; typedef enum _sign { Positive, Negative } Sign; #define SignNegate(sign) ((sign) == Positive ? Negative : Positive) typedef enum _signcat { BothPositive, FirstPositive, SecondPositive, BothNegative } Signcat; # define catagorize_signs(s1,s2)\ ((s1) == Positive ? \ ((s2) == Positive ? BothPositive : FirstPositive) \ : \ ((s2) == Positive ? SecondPositive : BothNegative)) typedef enum _binaryOp { PlusOp, MinusOp, TimesOp, DivideOp, DivOp, ModOp, LessOp, EqualOp, LandOp, LorOp, NumBinaryOp } BinaryOp; typedef enum _unaryOp { NegateOp, FloorOp, CeilOp, NumUnaryOp } UnaryOp; /* * Value representations. * * Values are represented by one of several data structures, * the first element of each value is a pointer back to a * data structure which contains the representation tag along * with functions that operate on the value */ typedef enum _rep { /* unknown type */ rep_undef = -1, /* primitive types */ rep_int = 0, rep_integer = 1, rep_rational = 2, rep_float = 3, rep_string = 4, rep_file = 5, rep_thread = 6, rep_semaphore = 7, rep_continuation = 8, rep_bool = 9, rep_foreign = 10, rep_void = 11, /* composite types */ rep_ref = 12, rep_func = 13, /* mutable type */ rep_array = 14, rep_struct = 15, rep_union = 16, rep_hash = 17 } Rep; /* because rep_undef is -1, using (unsigned) makes these a single compare */ #define Numericp(t) ((unsigned) (t) <= (unsigned) rep_float) #define Integralp(t) ((unsigned) (t) <= (unsigned) rep_integer) #define Mutablep(t) ((t) >= rep_array) extern ValueRep IntRep, IntegerRep, RationalRep, FloatRep; extern ValueRep StringRep, ArrayRep, FileRep; extern ValueRep RefRep, StructRep, UnionRep, HashRep; extern ValueRep FuncRep, ThreadRep; extern ValueRep SemaphoreRep, ContinuationRep, UnitRep, BoolRep; extern ValueRep ForeignRep; #define NewInt(i) ((Value) IntToPtr ((((i) << 1) | 1))) #define IntSign(i) ((i) < 0 ? Negative : Positive) /* * Use all but one bit to hold immediate integer values */ #define NICKLE_INT_BITS ((sizeof (int) * 8) - 1) #define NICKLE_INT_SIGN (1 << (NICKLE_INT_BITS - 1)) /* * this bit holds any overflow; when different from SIGN, * an addition/subtraction has overflowed */ #define NICKLE_INT_CARRY (1 << NICKLE_INT_BITS) /* * An int fits in a 'nickle int' if the top two bits * are the same. There are four initial values: * * 00 + 01 = 01 * 01 + 01 = 10 * 10 + 01 = 11 * 11 + 01 = 00 * * So, the two 'naughty' ones end up with the high bit set */ #define NICKLE_INT_CARRIED(r) (((r) + NICKLE_INT_SIGN) & NICKLE_INT_CARRY) #define MAX_NICKLE_INT ((int) ((unsigned) NICKLE_INT_SIGN - 1)) #define MIN_NICKLE_INT (-MAX_NICKLE_INT - 1) #define One NewInt(1) #define Zero NewInt(0) #define ValueIsPtr(v) ((PtrToInt(v) & 1) == 0) #define ValueIsInt(v) (!ValueIsPtr(v)) #define ValueInt(v) (PtrToInt (v) >> 1) #define ValueRep(v) (ValueIsInt(v) ? &IntRep : (v)->value.type) #define ValueIsInteger(v) (ValueRep(v) == &IntegerRep) #define ValueIsRational(v) (ValueRep(v) == &RationalRep) #define ValueIsFloat(v) (ValueRep(v) == &FloatRep) #define ValueIsString(v) (ValueRep(v) == &StringRep) #define ValueIsArray(v) (ValueRep(v) == &ArrayRep) #define ValueIsFile(v) (ValueRep(v) == &FileRep) #define ValueIsRef(v) (ValueRep(v) == &RefRep) #define ValueIsStruct(v) (ValueRep(v) == &StructRep) #define ValueIsUnion(v) (ValueRep(v) == &UnionRep) #define ValueIsHash(v) (ValueRep(v) == &HashRep) #define ValueIsFunc(v) (ValueRep(v) == &FuncRep) #define ValueIsThread(v) (ValueRep(v) == &ThreadRep) #define ValueIsSemaphore(v) (ValueRep(v) == &SemaphoreRep) #define ValueIsContinuation(v) (ValueRep(v) == &ContinuationRep) #define ValueIsUnit(v) (ValueRep(v) == &UnitRep) #define ValueIsBool(v) (ValueRep(v) == &BoolRep) #define ValueIsForeign(v) (ValueRep(v) == &ForeignRep) /* * Aggregate types */ typedef struct _argType { DataType *data; TypePtr type; Bool varargs; Atom name; SymbolPtr symbol; struct _argType *next; } ArgType; ArgType *NewArgType (TypePtr type, Bool varargs, Atom name, SymbolPtr symbol, ArgType *next); typedef enum _typeTag { type_prim, type_name, type_ref, type_func, type_array, type_struct, type_union, type_types, type_hash } TypeTag; typedef struct _typeBase { DataType *data; TypeTag tag; } TypeBase; typedef struct _typePrim { TypeBase base; Rep prim; } TypePrim; typedef struct _typeName { TypeBase base; ExprPtr expr; SymbolPtr name; } TypeName; #define TypeNameType(t) ((t)->name.name ? (t)->name.name->symbol.type : 0) typedef struct _typeRef { TypeBase base; TypePtr ref; Bool pointer; } TypeRef; typedef struct _typeFunc { TypeBase base; TypePtr ret; ArgType *args; } TypeFunc; typedef enum _dimStorage { DimStorageNone, DimStorageGlobal, DimStorageStatic, DimStorageAuto } DimStorage; typedef struct _typeArray { TypeBase base; TypePtr type; ExprPtr dimensions; int dims; DimStorage storage; Bool resizable; union { BoxPtr global; struct { int element; Bool staticScope; CodePtr code; } frame; } u; } TypeArray; typedef struct _typeHash { TypeBase base; TypePtr type; TypePtr keyType; } TypeHash; typedef struct _typeStruct { TypeBase base; StructTypePtr structs; Bool enumeration; } TypeStruct; typedef struct _typeElt { DataType *data; struct _typeElt *next; union _type *type; } TypeElt; typedef struct _typeTypes { TypeBase base; TypeElt *elt; } TypeTypes; typedef union _type { TypeBase base; TypePrim prim; TypeName name; TypeRef ref; TypeFunc func; TypeArray array; TypeHash hash; TypeStruct structs; TypeTypes types; } Type; typedef struct _argDecl { Type *type; Atom name; } ArgDecl; typedef struct _argList { ArgType *argType; Bool varargs; } ArgList; extern Type *typePoly; extern Type *typeRefPoly; extern Type *typeFileError; extern Type *typeArrayInt; extern Type *typePrim[rep_void + 1]; Type *NewTypeName (ExprPtr expr, SymbolPtr name); Type *NewTypeRef (Type *ref, Bool pointer); Type *NewTypePointer (Type *ref); Type *NewTypeFunc (Type *ret, ArgType *args); Type *NewTypeArray (Type *type, ExprPtr dimensions, Bool resizable); Type *NewTypeHash (Type *type, Type *keyType); Type *NewTypeStruct (StructTypePtr structs); Type *NewTypeUnion (StructTypePtr structs, Bool enumeration); Type *NewTypeTypes (TypeElt *elt); Type *TypeCanon (Type *type); void TypeTypesAdd (Type *list, Type *type); void TypeTypesRemove (Type *list, Type *type); Bool TypeTypesMember (Type *list, Type *type); int TypeInit (void); SymbolPtr TypeNameName (Type *t); #define TypeUnionElements(t) ((Type **) (&t->unions + 1)) Type *TypeCombineBinary (Type *left, int tag, Type *right); Type *TypeCombineUnary (Type *down, int tag); Type *TypeCombineStruct (Type *type, int tag, Atom atom); Type *TypeCombineReturn (Type *type); Type *TypeCombineFunction (Type *type); Type *TypeCombineArray (Type *array, int ndim, Bool lvalue); /* can assign value 'v' to variable of type 'dest' */ Bool TypeCompatibleAssign (Type *dest, Value v); /* super is a supertype of sub */ Bool TypeIsSupertype (Type *super, Type *sub); /* a is a supertype of b or b is a supertype of a */ Bool TypeIsOrdered (Type *a, Type *b); /* a and b are 'cotypes' */ Bool TypeIsCotype (Type *a, Type *b); #define TypePoly(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_undef) #define TypeBool(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_bool) #define TypeString(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_string) Bool TypeNumeric (Type *t); Bool TypeIntegral (Type *t); int TypeCountDimensions (ExprPtr dims); /* * storage classes */ typedef enum _class { class_global, class_static, class_arg, class_auto, class_const, class_typedef, class_namespace, class_exception, class_undef } Class; #define ClassLocal(c) ((c) == class_arg || (c) == class_auto) #define ClassFrame(c) ((c) == class_static || ClassLocal(c)) #define ClassStorage(c) ((c) <= class_const) #define ClassLvalue(c) ((c) <= class_auto) typedef enum _publish { publish_private, publish_protected, publish_public, publish_extend } Publish; #define ValueTag(v) (ValueRep(v)->tag) typedef struct _baseValue { ValueRep *type; } BaseValue; typedef struct _integer { BaseValue base; Natural *magn; } Integer; #define IntegerMag(i) ((Natural *) ((long) ((i)->integer.magn) & ~1)) #define IntegerSign(i) ((Sign) ((long) ((i)->integer.magn) & 1)) typedef struct _rational { BaseValue base; Sign sign; Natural *num; Natural *den; } Rational; typedef struct _fpart { DataType *data; Natural *mag; Sign sign; } Fpart; typedef struct _float { BaseValue base; Fpart *mant; Fpart *exp; unsigned prec; } Float; typedef struct _string { BaseValue base; long length; } String; #define StringChars(s) ((char *) ((s) + 1)) typedef struct _foreign { BaseValue base; const char *id; void *data; void (*mark)(void *); void (*free)(void *); } Foreign; /* * Resizable arrays are actually vectors of single entry * boxes. Otherwise shrinking the array leaves old references * dangling. */ typedef struct _boxVector { DataType *data; int nvalues; TypePtr type; } BoxVector, *BoxVectorPtr; #define BoxVectorBoxes(v) ((BoxPtr *) ((v) + 1)) typedef struct _array { BaseValue base; unsigned int resizable : 1; unsigned int ndim : (sizeof (int) * 8 - 1); union { BoxPtr fix; BoxVectorPtr resize; } u; } Array; #define ArrayDims(a) ((int *) ((a) + 1)) #define ArrayLimits(a) (ArrayDims(a) + (a)->ndim) #define ArrayConstant #define ArrayNvalues(a) ((a)->resizable ? (a)->u.resize->nvalues : (a)->u.fix->nvalues) #define ArrayValueBox(a,i) ((a)->resizable ? BoxVectorBoxes((a)->u.resize)[i] : (a)->u.fix) #define ArrayValueElt(a,i) ((a)->resizable ? 0 : (i)) #define ArrayType(a) ((a)->resizable ? (a)->u.resize->type : (a)->u.fix->u.type) #define ArrayValue(a,i) (BoxValue(ArrayValueBox(a,i),ArrayValueElt(a,i))) #define ArrayValueGet(a,i) (BoxValueGet(ArrayValueBox(a,i),ArrayValueElt(a,i))) #define ArrayValueSet(a,i,v) (BoxValueSet(ArrayValueBox(a,i),ArrayValueElt(a,i), v)) typedef struct _io_chain { DataType *data; struct _io_chain *next; int size; int used; int ptr; } FileChain, *FileChainPtr; typedef struct _file { BaseValue base; union _value *next; /* used to chain blocked files together */ int fd; int pid; /* for pipes, process id */ int status; /* from wait */ int input_errno; /* last input errno */ int output_errno; /* last output errno */ int flags; int error; FileChainPtr input; FileChainPtr output; } File; #define FileBufferSize 4096 #define FileEOF -1 #define FileBlocked -2 #define FileError -3 #define FileBuffer(ic) ((unsigned char *) ((ic) + 1)) #define FileReadable 0x0001 #define FileWritable 0x0002 #define FileOutputBlocked 0x0004 #define FileInputBlocked 0x0008 #define FileLineBuf 0x0010 #define FileUnBuf 0x0020 #define FileInputError 0x0040 #define FileOutputError 0x0080 #define FileClosed 0x0100 #define FileBlockWrites 0x0200 #define FileEnd 0x0400 #define FileString 0x0800 #define FilePipe 0x1000 #define FileIsPipe 0x2000 typedef struct _boxTypes { DataType *data; int count; int size; } BoxTypes, *BoxTypesPtr; #define BoxTypesElements(bt) ((TypePtr *) ((bt) + 1)) #define BoxTypesValue(bt,e) (BoxTypesElements(bt)[e]) extern BoxTypesPtr NewBoxTypes (int size); extern int AddBoxType (BoxTypesPtr *btp, TypePtr t); typedef struct _ref { BaseValue base; BoxPtr box; int element; } Ref; int RefRewrite (Value r); #define RefCheck(r) ((r)->ref.box->replace ? RefRewrite(r) : 0) #define RefValueSet(r,v) (RefCheck (r), BoxValueSet((r)->ref.box, (r)->ref.element, (v))) #define RefValue(r) (RefCheck (r), BoxValue((r)->ref.box, (r)->ref.element)) #define RefValueGet(r) (RefCheck (r), BoxValueGet((r)->ref.box, (r)->ref.element)) #define RefType(r) (RefCheck (r), BoxType((r)->ref.box, (r)->ref.element)) #define RefConstant(r) BoxConstant((r)->ref.box, (r)->ref.element) typedef struct _structType { DataType *data; int nelements; BoxTypesPtr types; } StructType; #define StructTypeAtoms(st) ((Atom *) (st + 1)) typedef struct _struct { BaseValue base; StructType *type; BoxPtr values; } Struct; typedef struct _union { BaseValue base; StructType *type; Atom tag; BoxPtr value; } Union; typedef struct _func { BaseValue base; CodePtr code; FramePtr staticLink; BoxPtr statics; } Func; /* * This is a continuation, the same structure is also used within * threads, twixts and catches to hold an execution context */ typedef struct _continuation { union { BaseValue value; DataType *data; } type; Value value; /* accumulator */ InstPtr pc; /* program counter */ ObjPtr obj; /* reference to obj containing pc */ FramePtr frame; /* function call frame list */ StackObject *stack; /* value stack */ CatchPtr catches; /* handled exceptions */ TwixtPtr twixts; /* pending twixts */ } Continuation; typedef enum _ThreadState { ThreadRunning = 0, ThreadSuspended = 1, ThreadInterrupted = 2, ThreadFinished = 4 } ThreadState; typedef struct _thread { /* * Execution continuation */ Continuation continuation; /* * Currently executing jump */ JumpPtr jump; /* * Thread status */ ThreadState state; int priority; Value sleep; int id; int partial; /* * Lower priority threads */ Value next; } Thread; #define PriorityMin 0 #define PriorityStart 100 #define PrioritySync 200 #define PriorityIo 300 typedef struct _semaphore { BaseValue value; int count; int id; } Semaphore; /* * Set the continuation at dst to that at src. Return the src * continuation instruction pointer */ InstPtr ContinuationSet (ContinuationPtr dst, ContinuationPtr src); /* * Jump through a continuation, unwinding or rewinding appropriate twixt blocks */ Value ContinuationJump (Value thread, ContinuationPtr src, Value ret, InstPtr *next); /* * Mark memory referenced from a continuation, */ void ContinuationMark (void *object); /* * Initialize a continuation to default values */ void ContinuationInit (ContinuationPtr continuation); #ifdef DEBUG_JUMP void ContinuationTrace (char *where, Continuation *continuation, int indent); void ThreadCatches (Value thread); #endif /* * Hash tables. Indexed by multiple typed values */ typedef const struct _HashSet { HashValue entries; HashValue size; HashValue rehash; } HashSetRec, *HashSetPtr; /* * Hash elements are stored in boxes, with three elements * for each element (hash, key, value) * * Hash element states: * * key value * 0 0 empty * v 0 reference to uninitialized element * 0 v deleted * v v valid entry * * So: * key != 0 -> hash table includes * value != 0 -> hash chain includes */ #define HashEltHash(e) ((e)[0]) #define HashEltKey(e) ((e)[1]) #define HashEltValue(e) ((e)[2]) #define HashEltSize 3 #define HashEltStep(e) ((e) += HashEltSize) #define HashEltCopy(d,s) (((d)[0] = (s)[0]), \ ((d)[1] = (s)[1]), \ ((d)[2] = (s)[2])) #define HashEltValid(e) (HashEltKey(e) != 0) #define HashEltChained(e) (HashEltValue(e) != 0) typedef struct _hashTable { BaseValue base; HashSetRec *hashSet; HashValue count; TypePtr type; TypePtr keyType; BoxPtr elts; Value def; } HashTable, *HashTablePtr; typedef union _value { BaseValue value; Integer integer; Rational rational; Float floats; String string; Array array; File file; Ref ref; Foreign foreign; Struct structs; Union unions; Func func; Thread thread; Semaphore semaphore; Continuation continuation; HashTable hash; } ValueRec; typedef Value (*Binary) (Value, Value, int); typedef Value (*Unary) (Value, int); typedef Value (*Promote) (Value, Value); typedef Value (*Coerce) (Value); typedef int (*Hash) (Value); #define DEFAULT_OUTPUT_PRECISION -1 #define INFINITE_OUTPUT_PRECISION -2 typedef Bool (*Output) (Value, Value, char format, int base, int width, int prec, int fill); typedef ValueRep *(*TypeCheck) (BinaryOp, Value, Value, int); struct _valueType { DataType data; Rep tag; Binary binary[NumBinaryOp]; Unary unary[NumUnaryOp]; Promote promote; Coerce reduce; Output print; TypeCheck typecheck; Hash hash; }; typedef struct _boxReplace { DataType *data; BoxPtr new; int oldstride; int newstride; } BoxReplace, *BoxReplacePtr; typedef struct _box { DataType *data; unsigned long constant : 1; unsigned long homogeneous : 1; unsigned long replace : 1; unsigned long nvalues : (sizeof (unsigned long) * 8) - 3; union { BoxTypesPtr types; TypePtr type; BoxReplacePtr replace; } u; } Box; #if 1 #define BoxCheck(box) assert (!(box)->replace), #else #define BoxCheck(box) #endif #define BoxElements(box) (BoxCheck (box) ((Value *) ((box) + 1))) #define BoxValueSet(box,e,v) ((BoxElements(box)[e]) = (v)) #define BoxValueGet(box,e) ((BoxElements(box)[e])) #define BoxConstant(box,e) ((box)->constant) #define BoxReplace(box) ((box)->replace) #define BoxType(box,e) (BoxCheck (box) ((box)->homogeneous ? (box)->u.type : \ BoxTypesValue((box)->u.types, e))) extern BoxPtr NewBox (Bool constant, Bool array, int nvalues, TypePtr type); extern BoxPtr NewTypedBox (Bool array, BoxTypesPtr types); void BoxSetReplace (BoxPtr old, BoxPtr new, int oldstride, int newstride); BoxPtr BoxRewrite (BoxPtr box, int *ep); typedef struct { DataType *data; int size; } DataCache, *DataCachePtr; DataCachePtr NewDataCache (int size); #define DataCacheValues(vc) ((void *) ((vc) + 1)) Value NewInteger (Sign sign, Natural *mag); Value NewIntInteger (int value); Value NewSignedDigitInteger (signed_digit d); Value NewRational (Sign sign, Natural *num, Natural *den); Value NewIntRational (int value); Value NewIntegerRational (Integer *); Value NewFloat (Fpart *mant, Fpart *exp, unsigned prec); Value NewIntFloat (int i, unsigned prec); Value NewIntegerFloat (Integer *i, unsigned prec); Value NewNaturalFloat (Sign sign, Natural *n, unsigned prec); Value NewRationalFloat (Rational *r, unsigned prec); Value NewValueFloat (Value av, unsigned prec); Value NewDoubleFloat (double d); Value NewContinuation (ContinuationPtr continuation, InstPtr pc); Value NewForeign (const char *id, void *data, void (*mark)(void *data), void (*free)(void *data)); unsigned FpartLength (Fpart *a); #define DEFAULT_FLOAT_PREC 256 #define REF_CACHE_SIZE 1031 extern DataCachePtr refCache; Value NewString (long length); Value NewStrString (const char *); Value NewCharString (int c); Value NewArray (Bool constant, Bool resizable, TypePtr type, int ndim, int *dims); void ArrayResize (Value av, int dim, int size); void ArraySetDimensions (Value av, int *dims); Value NewHash (Bool constant, TypePtr keyType, TypePtr valueType); Value HashGet (Value hv, Value key); void HashSet (Value hv, Value key, Value value); void HashSetDef (Value hv, Value def); Value HashKeys (Value hv); Value HashRef (Value hv, Value key); Value HashTest (Value hv, Value key); void HashDelete (Value hv, Value key); Value HashCopy (Value hv); Value NewFile (int fd); Value NewRefReal (BoxPtr box, int element, Value *re); char *StringNextChar (char *src, unsigned *dst, long *length); int StringPutChar (unsigned c, char *dest); int StringLength (char *src, long length); int StringCharSize (unsigned c); unsigned StringGet (char *src, long len, int i); char *StrzPart (Value, char *error); #ifdef HAVE_C_INLINE static inline Value NewRef (BoxPtr box, int element) { int c = (PtrToUInt (&BoxElements(box)[element])) % REF_CACHE_SIZE; Value *re = (Value *) (DataCacheValues(refCache)) + c; Value ret = *re; if (ret && ret->ref.box == box && ret->ref.element == element) { REFERENCE (ret); return ret; } return NewRefReal (box, element, re); } #else Value NewRef (BoxPtr box, int element); #endif Value NewStruct (StructType *type, Bool constant); StructType *NewStructType (int nelements); Type *BuildStructType (int nelements, ...); Type *StructMemType (StructType *st, Atom name); Value StructMemRef (Value sv, Atom name); Value StructMemValue (Value sv, Atom name); Value NewUnion (StructType *type, Bool constant); Type *BuildUnionType (int nelements, ...); Type *BuildEnumType (int nelements, ...); Value UnionValue (Value uv, Atom name); Value UnionRef (Value uv, Atom name); Type *BuildArrayType (Type *type, int ndim, ...); Value BinaryOperate (Value av, Value bv, BinaryOp operator); Value UnaryOperate (Value v, UnaryOp operator); Value NumericDiv (Value av, Value bv, int expandOk); # define OK_TRUNC 1 extern Value Blank, Elementless, Void, TrueVal, FalseVal; # define True(v) ((v) == TrueVal) # define False(v) ((v) != TrueVal) Value FileGetError (int err); char *FileGetErrorMessage (int err); int FileInput (Value); int FileOutput (Value, char); void FileUnput (Value, unsigned char); int FileInchar (Value); int FileOutchar (Value, int); void FileUnchar (Value, int); Value FileCreate (int fd, int flags); int FileFlush (Value, Bool block); int FileClose (Value); Value FileStringRead (char *string, int len); Value FileStringWrite (void); Value FileStringString (Value file); void FileSetFd (int fd), FileResetFd (int fd); Bool FileIsReadable (int fd); Bool FileIsWritable (int fd); void FilePutsc (Value, char *, long length); void FilePuts (Value, char *); void FilePutDoubleDigitBase (Value file, double_digit a, int base); void FilePutUIntBase (Value file, unsigned int a, int base); void FilePutIntBase (Value file, int a, int base); void FilePutInt (Value, int); int FileStringWidth (char *string, long length, char format); void FilePutString (Value f, char *string, long length, char format); void FilePutRep (Value f, Rep tag, Bool minimal); void FilePutClass (Value f, Class storage, Bool minimal); void FilePutPublish (Value f, Publish publish, Bool minimal); void FilePutType (Value f, Type *t, Bool minimal); void FilePutBaseType (Value f, Type *t, Bool minimal); void FilePutSubscriptType (Value f, Type *t, Bool minimal); Value FileFilter (char *program, char *args[], Value filev, int *errp); Value FileFopen (char *name, char *mode, int *errp); Value FileReopen (char *name, char *mode, Value file, int *errp); Value FileMakePipe (int *errp); void FilePutArgType (Value f, ArgType *at); int FileStatus (Value file); void FileCheckBlocked (Bool block); void FileSetBlocked (Value file, int flag); void FilePrintf (Value, char *, ...); void FileVPrintf (Value, char *, va_list); void FileSetBuffer (Value file, int buf); extern Bool anyFileWriteBlocked; extern Bool anyPipeReadBlocked; extern Value FileStdin, FileStdout, FileStderr; typedef Value (*BinaryFunc) (Value, Value); typedef Value (*UnaryFunc) (Value); #define Plus(av,bv) BinaryOperate (av, bv, PlusOp) #define Minus(av,bv) BinaryOperate (av, bv, MinusOp) #define Times(av,bv) BinaryOperate (av, bv, TimesOp) #define Divide(av,bv) BinaryOperate (av, bv, DivideOp) #define Div(av,bv) BinaryOperate (av, bv, DivOp) #define Mod(av,bv) BinaryOperate (av, bv, ModOp) #define Less(av,bv) BinaryOperate (av, bv, LessOp) #define Equal(av,bv) BinaryOperate (av, bv, EqualOp) #define Land(av,bv) BinaryOperate (av, bv, LandOp) #define Lor(av,bv) BinaryOperate (av, bv, LorOp) int logbase2(int a); Value Greater (Value, Value), LessEqual (Value, Value); Value GreaterEqual (Value, Value), NotEqual (Value, Value); Value Not (Value); Value Negate (Value), Floor (Value), Ceil (Value); Value Truncate (Value); Value Round (Value); Value Pow (Value, Value), Factorial (Value), Reduce (Value); Value ShiftL (Value, Value), ShiftR (Value, Value); Value Gcd (Value, Value); #undef GCD_DEBUG #ifdef GCD_DEBUG Value Bdivmod (Value av, Value bv); Value KaryReduction (Value av, Value bv); #endif Value Lxor(Value, Value), Lnot (Value); Value Popcount(Value); Bool Print (Value, Value, char format, int base, int width, int prec, int fill); void PrintError (char *s, ...); HashValue HashCrc32 (unsigned char *bytes, int nbytes); Value CopyMutable (Value v); #ifdef HAVE_C_INLINE static inline Value Copy (Value v) { if (v && Mutablep (ValueTag(v))) return CopyMutable (v); return v; } #else Value Copy (Value); #endif Value ValueEqual (Value a, Value b, int expandOk); Value ValueHash (Value a); /* * There are two kinds of signals: * * aborting current instruction should be suspended * non-aborting current instruction should be completed * * SIGIO and SIGALRM are non-aborting; otherwise computation would probably * never make progress * * SIGINTR is aborting * All internal signals are aborting * * An aborting signal marks 'aborting, signaling' and itself, this way * low-level computations can check 'aborting' and the interpreter can * check 'signaling' and then check the individual signals */ extern volatile Bool aborting; /* abort current instruction */ extern volatile Bool signaling; /* some signal is pending */ /* * Any signal state set by an signal handler must be volatile */ extern volatile Bool signalInterrupt; /* keyboard interrupt */ extern volatile Bool signalTimer; /* timer interrupt */ extern volatile Bool signalIo; /* i/o interrupt */ extern volatile Bool signalProfile; /* vtimer interrupt */ extern volatile Bool signalChild; /* sub process interrupt */ #define SetSignalInterrupt()(aborting = signaling = signalInterrupt = True) #define SetSignalTimer() (signaling = signalTimer = True) #define SetSignalIo() (signaling = signalIo = True) #define SetSignalProfile() (signaling = signalProfile = True) #define SetSignalChild() (signaling = signalChild = True) /* * Any signal state set by regular code doesn't need to be volatile */ extern Bool signalSuspend; /* current thread suspend */ extern Bool signalFinished; /* current thread done */ extern Bool signalException; /* current thread exception pending */ extern Bool signalError; /* current thread run time error */ #define SetSignalSuspend() (aborting = signaling = signalSuspend = True) #define SetSignalFinished() (aborting = signaling = signalFinished = True) #define SetSignalException()(aborting = signaling = signalException = True) #define SetSignalError() (aborting = signaling = signalError = True) int NaturalToInt (Natural *); int IntegerToInt (Integer *); int IntPart (Value, char *error); double DoublePart (Value av, char *error); #ifndef Numericp Bool Numericp (Rep); #endif #ifndef Integralp Bool Integralp (Rep); #endif Bool Zerop (Value); Bool Negativep (Value); Bool Evenp (Value); #ifdef HAVE_C_INLINE #define INLINE inline #else #define INLINE #endif int ArrayInit (void); int AtomInit (void); int FileInit (void); int IntInit (void); int HashInit (void); int NaturalInit (void); int IntegerInit (void); int RationalInit (void); int FpartInit (void); int StringInit (void); int StructInit (void); int RefInit (void); int ForeignInit (void); int ValueInit (void); # define oneNp(n) ((n)->length == 1 && NaturalDigits(n)[0] == 1) # define zeroNp(n) ((n)->length == 0) void ferr(int); void ignore_ferr (void); #endif /* _VALUE_H_ */