1 /*
2 * Copyright © 1988-2007 Keith Packard and Bart Massey.
3 * All Rights Reserved. See the file COPYING in this directory
4 * for licensing information.
5 */
6
7 /*
8 * value.h
9 *
10 * type definitions for functions returning values
11 */
12
13 #ifndef _VALUE_H_
14 #define _VALUE_H_
15 #include <stdio.h>
16 #include <stdarg.h>
17 #include <unistd.h>
18 #include <stdlib.h>
19 #include <memory.h>
20 #include <string.h>
21 #include <signal.h>
22 #include <assert.h>
23
24 typedef enum { False = 0, True = 1 } Bool;
25 typedef char *Atom;
26 #ifndef MEM_TRACE
27 typedef const struct _valueType ValueRep;
28 #else
29 typedef struct _valueType ValueRep;
30 #endif
31 typedef struct _box *BoxPtr;
32 typedef union _code *CodePtr;
33 typedef struct _frame *FramePtr;
34 typedef struct _thread *ThreadPtr;
35 typedef struct _continuation *ContinuationPtr;
36 typedef union _value *Value;
37 typedef struct _obj *ObjPtr;
38 typedef union _inst *InstPtr;
39 typedef union _symbol *SymbolPtr;
40
41 extern Atom AtomId (char *name);
42 #define AtomName(a) (a)
43 extern int AtomInit (void);
44
45 typedef struct _AtomList *AtomListPtr;
46 typedef union _type *TypePtr;
47 typedef struct _structType *StructTypePtr;
48 typedef union _expr *ExprPtr;
49 typedef struct _catch *CatchPtr;
50 typedef struct _twixt *TwixtPtr;
51 typedef struct _jump *JumpPtr;
52
53 typedef struct _AtomList {
54 DataType *data;
55 AtomListPtr next;
56 Atom atom;
57 } AtomList;
58
59 AtomListPtr NewAtomList (AtomListPtr next, Atom atom);
60
61 /*
62 * computational radix for natural numbers. Make sure the
63 * definitions for digit, double_digit and signed_digit will
64 * still work correctly.
65 */
66
67 #if HAVE_STDINT_H
68
69 # include <stdint.h>
70
71 #define PtrToInt(p) ((int) (intptr_t) (p))
72 #define PtrToUInt(p) ((unsigned) (uintptr_t) (p))
73 #define IntToPtr(i) ((void *) (intptr_t) (i))
74 #define UIntToPtr(u) ((void *) (uintptr_t) (u))
75
76 # if HAVE_UINT64_T
77
78 /*
79 * If stdint.h defines a 64 bit datatype, use 32 bit
80 * chunks
81 */
82
83 # define DIGITBITS 32
84 typedef uint64_t double_digit;
85 typedef int64_t signed_digit;
86 typedef uint32_t digit;
87
88 # else
89
90 # define DIGITBITS 16
91 typedef uint32_t double_digit;
92 typedef uint16_t digit;
93 typedef int32_t signed_digit;
94
95 # endif
96
97 #else
98
99 #define PtrToInt(p) ((int) (p))
100 #define PtrToUInt(p) ((unsigned) (p))
101 #define IntToPtr(i) ((void *) (i))
102 #define UIntToPtr(u) ((void *) (u))
103
104 # if SIZEOF_UNSIGNED_LONG_LONG == 8 || SIZEOF_UNSIGNED_LONG == 8
105 # define DIGITBITS 32
106 # else
107 # define DIGITBITS 16
108 # endif
109
110 # if DIGITBITS == 32
111
112 # if SIZEOF_UNSIGNED_LONG_LONG == 8
113 typedef unsigned long long double_digit;
114 typedef long long signed_digit;
115 # else
116 # if SIZEOF_UNSIGNED_LONG == 8
117 typedef unsigned long double_digit;
118 typedef long signed_digit;
119 # endif
120 # endif
121
122 # if SIZEOF_UNSIGNED_LONG == 4
123 typedef unsigned long digit;
124 # else
125 # if SIZEOF_UNSIGNED_INT == 4
126 typedef unsigned int digit;
127 # endif
128 # endif
129
130 # else
131
132 # if SIZEOF_UNSIGNED_LONG == 4
133 typedef unsigned long double_digit;
134 typedef long signed_digit;
135 # else
136 # if SIZEOF_UNSIGNED_INT == 4
137 typedef unsigned int double_digit;
138 typedef int signed_digit;
139 # endif
140 # endif
141
142 # if SIZEOF_UNSIGNED_INT == 2
143 typedef unsigned int digit;
144 # else
145 # if SIZEOF_UNSIGNED_SHORT == 2
146 typedef unsigned short digit;
147 # endif
148 # endif
149
150 # endif
151
152 #endif
153
154 #define MAXDIGIT ((digit) (BASE - 1))
155
156 #if DIGITBITS == 32
157 # define BASE ((double_digit) 65536 * (double_digit) 65536)
158 # define LBASE2 32
159 # define LLBASE2 5
160 #else
161 # define BASE ((double_digit) 65536)
162 # define LBASE2 16
163 # define LLBASE2 4
164 #endif
165
166 #define TwoDigits(n,i) ((double_digit) NaturalDigits(n)[i-1] | \
167 ((double_digit) NaturalDigits(n)[i] << LBASE2))
168 #define ModBase(t) ((t) & (((double_digit) 1 << LBASE2) - 1))
169 #define DivBase(t) ((t) >> LBASE2)
170
171 /* HashValues are stored in rep_int */
172
173 typedef int HashValue;
174
175 /*
176 * Natural numbers form the basis for both the Integers and Rationals,
177 * but needn't ever be exposed to the user
178 */
179
180 typedef struct _natural {
181 DataType *type;
182 int length;
183 digit digits[0];
184 } Natural;
185
NaturalLength(Natural * n)186 static inline int NaturalLength(Natural *n)
187 {
188 return n->length;
189 }
190
NaturalDigits(Natural * n)191 static inline digit * NaturalDigits(Natural *n)
192 {
193 return n->digits;
194 }
195
196 Natural *NewNatural (unsigned value);
197 Natural *NewDoubleDigitNatural (double_digit dd);
198 Natural *AllocNatural (int size);
199 Bool NaturalEqual (Natural *, Natural *);
200 Bool NaturalLess (Natural *, Natural *);
201 Natural *NaturalPlus (Natural *, Natural *);
202 Natural *NaturalMinus (Natural *, Natural *);
203 Natural *NaturalTimes (Natural *, Natural *);
204 Natural *NaturalLand (Natural *, Natural *);
205 Natural *NaturalLor (Natural *, Natural *);
206 Natural *NaturalCompliment (Natural *, int len);
207 Natural *NaturalNegate (Natural *, int len);
208 Natural *NaturalDivide (Natural *a, Natural *b, Natural **remp);
209 Natural *NaturalGcd (Natural *a, Natural *b);
210 char *NaturalSprint (char *, Natural *, int base, int *width);
211 Natural *NaturalSqrt (Natural *);
212 Natural *NaturalFactor (Natural *n, Natural *max);
213 Natural *NaturalIntPow (Natural *n, int p);
214 Natural *NaturalPow (Natural *n, Natural *);
215 Natural *NaturalPowMod (Natural *n, Natural *p, Natural *m);
216 Natural *NaturalRsl (Natural *v, int shift);
217 Natural *NaturalLsl (Natural *v, int shift);
218 Natural *NaturalMask (Natural *v, int bits);
219 int NaturalPowerOfTwo (Natural *v);
220 int NaturalEstimateLength (Natural *, int base);
221 void NaturalCopy (Natural *, Natural *);
222 Bool NaturalZero (Natural *);
223 Bool NaturalEven (Natural *);
224 void NaturalDigitMultiply (Natural *a, digit i, Natural *result);
225 digit NaturalSubtractOffset (Natural *a, Natural *b, int offset);
226 digit NaturalSubtractOffsetReverse (Natural *a, Natural *b, int offset);
227 Bool NaturalGreaterEqualOffset (Natural *a, Natural *b, int offset);
228 void NaturalAddOffset (Natural *a, Natural *b, int offset);
229 Natural *NaturalBdivmod (Natural *u_orig, Natural *v);
230 Natural *NaturalKaryReduction (Natural *u_orig, Natural *v);
231 int NaturalWidth (Natural *u);
232 digit DigitBmod (digit u, digit v, int s);
233 int IntWidth (int i);
234 int DoubleDigitWidth (double_digit i);
235 HashValue NaturalHash (Natural *a);
236
237 extern Natural *max_signed_digit_natural;
238 extern Natural *max_int_natural;
239 extern Natural *zero_natural;
240 extern Natural *one_natural;
241 extern Natural *two_natural;
242
243 typedef enum _sign { Positive = 0, Negative = 1 } Sign;
244
SignNegate(Sign sign)245 static inline Sign SignNegate(Sign sign) {
246 return 1 - sign;
247 }
248
249 typedef enum _signcat {
250 BothPositive = 0, FirstPositive = 1, SecondPositive = 2, BothNegative = 3
251 } Signcat;
252
catagorize_signs(Sign s1,Sign s2)253 static inline Signcat catagorize_signs(Sign s1, Sign s2) {
254 return (s1 << 1) | s2;
255 }
256
257 typedef enum _binaryOp {
258 PlusOp, MinusOp, TimesOp, DivideOp, DivOp, ModOp,
259 LessOp, EqualOp, LandOp, LorOp, NumBinaryOp
260 } BinaryOp;
261
262 typedef enum _unaryOp {
263 NegateOp, FloorOp, CeilOp, NumUnaryOp
264 } UnaryOp;
265
266 /*
267 * Value representations.
268 *
269 * Values are represented by one of several data structures,
270 * the first element of each value is a pointer back to a
271 * data structure which contains the representation tag along
272 * with functions that operate on the value
273 */
274 typedef enum _rep {
275 /* unknown type */
276 rep_undef = -1,
277 /* primitive types */
278 rep_int = 0,
279 rep_integer = 1,
280 rep_rational = 2,
281 rep_float = 3,
282 rep_string = 4,
283 rep_file = 5,
284 rep_thread = 6,
285 rep_semaphore = 7,
286 rep_continuation = 8,
287 rep_bool = 9,
288 rep_foreign = 10,
289 rep_void = 11,
290
291 /* composite types */
292 rep_ref = 12,
293 rep_func = 13,
294
295 /* mutable type */
296 rep_array = 14,
297 rep_struct = 15,
298 rep_union = 16,
299 rep_hash = 17
300 } Rep;
301
302 /* because rep_undef is -1, using (unsigned) makes these a single compare */
303 #define Numericp(t) ((unsigned) (t) <= (unsigned) rep_float)
304 #define Integralp(t) ((unsigned) (t) <= (unsigned) rep_integer)
305
306
307 #define Mutablep(t) ((t) >= rep_array)
308
309 extern ValueRep IntRep, IntegerRep, RationalRep, FloatRep;
310 extern ValueRep StringRep, ArrayRep, FileRep;
311 extern ValueRep RefRep, StructRep, UnionRep, HashRep;
312 extern ValueRep FuncRep, ThreadRep;
313 extern ValueRep SemaphoreRep, ContinuationRep, UnitRep, BoolRep;
314 extern ValueRep ForeignRep;
315
NewInt(int i)316 static inline Value NewInt(int i) {
317 return (Value) IntToPtr ((((i) << 1) | 1));
318 }
319
IntSign(int i)320 static inline Sign IntSign(int i) {
321 return (i) < 0 ? Negative : Positive;
322 }
323
324 /*
325 * Use all but one bit to hold immediate integer values
326 */
327 #define NICKLE_INT_BITS ((sizeof (int) * 8) - 1)
328 #define NICKLE_INT_SIGN (1U << (NICKLE_INT_BITS - 1))
329 /*
330 * this bit holds any overflow; when different from SIGN,
331 * an addition/subtraction has overflowed
332 */
333 #define NICKLE_INT_CARRY (1U << NICKLE_INT_BITS)
334 /*
335 * An int fits in a 'nickle int' if the top two bits
336 * are the same. There are four initial values:
337 *
338 * 00 + 01 = 01
339 * 01 + 01 = 10
340 * 10 + 01 = 11
341 * 11 + 01 = 00
342 *
343 * So, the two 'naughty' ones end up with the high bit set
344 */
345 #define NICKLE_INT_CARRIED(r) (((r) + NICKLE_INT_SIGN) & NICKLE_INT_CARRY)
346
347 #define MAX_NICKLE_INT ((int) ((unsigned) NICKLE_INT_SIGN - 1))
348 #define MIN_NICKLE_INT (-MAX_NICKLE_INT - 1)
349 #define MAX_NICKLE_SIGNED_DIGIT ((signed_digit) (((double_digit) 1 << (sizeof(signed_digit) * 8 - 1)) - 1))
350
351 #define One NewInt(1)
352 #define Zero NewInt(0)
353
ValueIsPtr(Value v)354 static inline Bool ValueIsPtr (Value v) {
355 return (PtrToInt(v) & 1) == 0;
356 }
357
ValueIsInt(Value v)358 static inline Bool ValueIsInt (Value v) {
359 return !ValueIsPtr(v);
360 }
361
ValueInt(Value v)362 static inline int ValueInt(Value v) {
363 return PtrToInt (v) >> 1;
364 }
365
366 static inline ValueRep *_ValueRep(Value v);
367
368 #define ValueRep(v) _ValueRep(v)
369 #define ValueIsInteger(v) (ValueRep(v) == &IntegerRep)
370 #define ValueIsRational(v) (ValueRep(v) == &RationalRep)
371 #define ValueIsFloat(v) (ValueRep(v) == &FloatRep)
372 #define ValueIsString(v) (ValueRep(v) == &StringRep)
373 #define ValueIsArray(v) (ValueRep(v) == &ArrayRep)
374 #define ValueIsFile(v) (ValueRep(v) == &FileRep)
375 #define ValueIsRef(v) (ValueRep(v) == &RefRep)
376 #define ValueIsStruct(v) (ValueRep(v) == &StructRep)
377 #define ValueIsUnion(v) (ValueRep(v) == &UnionRep)
378 #define ValueIsHash(v) (ValueRep(v) == &HashRep)
379 #define ValueIsFunc(v) (ValueRep(v) == &FuncRep)
380 #define ValueIsThread(v) (ValueRep(v) == &ThreadRep)
381 #define ValueIsSemaphore(v) (ValueRep(v) == &SemaphoreRep)
382 #define ValueIsContinuation(v) (ValueRep(v) == &ContinuationRep)
383 #define ValueIsUnit(v) (ValueRep(v) == &UnitRep)
384 #define ValueIsBool(v) (ValueRep(v) == &BoolRep)
385 #define ValueIsForeign(v) (ValueRep(v) == &ForeignRep)
386
387 /*
388 * Aggregate types
389 */
390 typedef struct _argType {
391 DataType *data;
392 TypePtr type;
393 Bool varargs;
394 Atom name;
395 SymbolPtr symbol;
396 struct _argType *next;
397 } ArgType;
398
399 ArgType *NewArgType (TypePtr type, Bool varargs, Atom name,
400 SymbolPtr symbol, ArgType *next);
401
402 typedef enum _typeTag {
403 type_prim, type_name, type_ref, type_func, type_array,
404 type_struct, type_union, type_types, type_hash
405 } TypeTag;
406
407 typedef struct _typeBase {
408 DataType *data;
409 TypeTag tag;
410 } TypeBase;
411
412 typedef struct _typePrim {
413 TypeBase base;
414 Rep prim;
415 } TypePrim;
416
417 typedef struct _typeName {
418 TypeBase base;
419 ExprPtr expr;
420 SymbolPtr name;
421 } TypeName;
422
423 typedef struct _typeRef {
424 TypeBase base;
425 TypePtr ref;
426 Bool pointer;
427 } TypeRef;
428
429 typedef struct _typeFunc {
430 TypeBase base;
431 TypePtr ret;
432 ArgType *args;
433 } TypeFunc;
434
435 typedef enum _dimStorage {
436 DimStorageNone, DimStorageGlobal, DimStorageStatic, DimStorageAuto
437 } DimStorage;
438
439 typedef struct _typeArray {
440 TypeBase base;
441 TypePtr type;
442 ExprPtr dimensions;
443 int dims;
444 DimStorage storage;
445 Bool resizable;
446 union {
447 BoxPtr global;
448 struct {
449 int element;
450 Bool staticScope;
451 CodePtr code;
452 } frame;
453 } u;
454 } TypeArray;
455
456 typedef struct _typeHash {
457 TypeBase base;
458 TypePtr type;
459 TypePtr keyType;
460 } TypeHash;
461
462 typedef struct _typeStruct {
463 TypeBase base;
464 StructTypePtr structs;
465 Bool enumeration;
466 TypePtr left, right;
467 } TypeStruct;
468
469 typedef struct _typeElt {
470 DataType *data;
471 struct _typeElt *next;
472 union _type *type;
473 } TypeElt;
474
475 typedef struct _typeTypes {
476 TypeBase base;
477 TypeElt *elt;
478 } TypeTypes;
479
480 typedef union _type {
481 TypeBase base;
482 TypePrim prim;
483 TypeName name;
484 TypeRef ref;
485 TypeFunc func;
486 TypeArray array;
487 TypeHash hash;
488 TypeStruct structs;
489 TypeTypes types;
490 } Type;
491
492 typedef struct _argDecl {
493 Type *type;
494 Atom name;
495 } ArgDecl;
496
497 typedef struct _argList {
498 ArgType *argType;
499 Bool varargs;
500 } ArgList;
501
502 extern Type *typePoly;
503 extern Type *typeRefPoly;
504 extern Type *typeFileError;
505 extern Type *typeArrayInt;
506 extern Type *typePrim[rep_void + 1];
507
508 Type *NewTypeName (ExprPtr expr, SymbolPtr name);
509 Type *NewTypeRef (Type *ref, Bool pointer);
510 Type *NewTypePlus (Type *left, Type *right);
511 Type *NewTypePointer (Type *ref);
512 Type *NewTypeFunc (Type *ret, ArgType *args);
513 Type *NewTypeArray (Type *type, ExprPtr dimensions, Bool resizable);
514 Type *NewTypeHash (Type *type, Type *keyType);
515 Type *NewTypeStruct (StructTypePtr structs);
516 Type *NewTypeUnion (StructTypePtr structs, Bool enumeration);
517 Type *NewTypeTypes (TypeElt *elt);
518 Type *TypeCanon (Type *type);
519 void TypeTypesAdd (Type *list, Type *type);
520 void TypeTypesRemove (Type *list, Type *type);
521 Bool TypeTypesMember (Type *list, Type *type);
522 int TypeInit (void);
523 SymbolPtr TypeNameName (Type *t);
524
525 Type *TypeCombineBinary (Type *left, int tag, Type *right);
526 Type *TypeCombineUnary (Type *down, int tag);
527 Type *TypeCombineStruct (Type *type, int tag, Atom atom);
528 Type *TypeCombineReturn (Type *type);
529 Type *TypeCombineFunction (Type *type);
530 Type *TypeCombineArray (Type *array, int ndim, Bool lvalue);
531 /* can assign value 'v' to variable of type 'dest' */
532 Bool TypeCompatibleAssign (Type *dest, Value v);
533 /* is value 'v' a subtype of 't' */
534 Bool ValueIsType (Value b, TypePtr a);
535 /* super is a supertype of sub */
536 Bool TypeIsSupertype (Type *super, Type *sub);
537 /* a is a supertype of b or b is a supertype of a */
538 Bool TypeIsOrdered (Type *a, Type *b);
539 /* a and b are 'cotypes' */
540 Bool TypeIsCotype (Type *a, Type *b);
541
542 #define TypePoly(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_undef)
543 #define TypeBool(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_bool)
544 #define TypeString(t) ((t)->base.tag == type_prim && (t)->prim.prim == rep_string)
545
546 Bool TypeNumeric (Type *t);
547 Bool TypeIntegral (Type *t);
548 int TypeCountDimensions (ExprPtr dims);
549
550 /*
551 * storage classes
552 */
553
554 typedef enum _class {
555 class_global, class_static, class_arg, class_auto, class_const,
556 class_typedef, class_namespace, class_exception, class_undef
557 } Class;
558
559 #define ClassLocal(c) ((c) == class_arg || (c) == class_auto)
560 #define ClassFrame(c) ((c) == class_static || ClassLocal(c))
561 #define ClassStorage(c) ((c) <= class_const)
562 #define ClassLvalue(c) ((c) <= class_auto)
563
564 typedef enum _publish {
565 publish_private, publish_protected, publish_public, publish_extend
566 } Publish;
567
568 static inline Rep ValueTag(Value v);
569
570 typedef struct _baseValue {
571 ValueRep *type;
572 } BaseValue;
573
574 typedef struct _integer {
575 BaseValue base;
576 Natural *magn;
577 } Integer;
578
579 typedef struct _rational {
580 BaseValue base;
581 Sign sign;
582 Natural *num;
583 Natural *den;
584 } Rational;
585
586 typedef struct _fpart {
587 DataType *data;
588 Natural *mag;
589 Sign sign;
590 } Fpart;
591
592 typedef struct _float {
593 BaseValue base;
594 Fpart *mant;
595 Fpart *exp;
596 unsigned prec;
597 } Float;
598
599 typedef struct _string {
600 BaseValue base;
601 long length;
602 char chars[0];
603 } String;
604
605 static inline char *
StringChars(String * s)606 StringChars (String *s)
607 {
608 return s->chars;
609 }
610
611 typedef struct _foreign {
612 BaseValue base;
613 const char *id;
614 void *data;
615 void (*mark)(void *);
616 void (*free)(void *);
617 } Foreign;
618
619 /*
620 * Resizable arrays are actually vectors of single entry
621 * boxes. Otherwise shrinking the array leaves old references
622 * dangling.
623 */
624
625 typedef struct _boxVector {
626 DataType *data;
627 int nvalues;
628 TypePtr type;
629 BoxPtr boxes[0];
630 } BoxVector, *BoxVectorPtr;
631
BoxVectorBoxes(BoxVector * v)632 static inline BoxPtr *BoxVectorBoxes(BoxVector *v)
633 {
634 return (BoxPtr *) v->boxes;
635 }
636
637 typedef struct _array {
638 BaseValue base;
639 unsigned int resizable : 1;
640 unsigned int ndim : (sizeof (int) * 8 - 1);
641 union {
642 BoxPtr fix;
643 BoxVectorPtr resize;
644 } u;
645 int dims[0];
646 } Array;
647
648 typedef struct _io_chain {
649 struct _io_chain *next;
650 int size;
651 int used;
652 int ptr;
653 unsigned char buffer[0];
654 } FileChain, *FileChainPtr;
655
656 typedef struct _file {
657 BaseValue base;
658 union _value *next; /* used to chain blocked files together */
659 int fd;
660 int pid; /* for pipes, process id */
661 int status; /* from wait */
662 int input_errno; /* last input errno */
663 int output_errno; /* last output errno */
664 int flags;
665 int error;
666 FileChainPtr input;
667 FileChainPtr output;
668 int sock_family;
669 } File;
670
671 #define FileBufferSize 4096
672 #define FileEOF -1
673 #define FileBlocked -2
674 #define FileError -3
675 #define FileBuffer(ic) ((ic)->buffer)
676
677 #define FileReadable 0x0001
678 #define FileWritable 0x0002
679 #define FileOutputBlocked 0x0004
680 #define FileInputBlocked 0x0008
681 #define FileLineBuf 0x0010
682 #define FileUnBuf 0x0020
683 #define FileInputError 0x0040
684 #define FileOutputError 0x0080
685 #define FileClosed 0x0100
686 #define FileBlockWrites 0x0200
687 #define FileEnd 0x0400
688 #define FileString 0x0800
689 #define FilePipe 0x1000
690 #define FileIsPipe 0x2000
691
692 typedef struct _boxTypes {
693 DataType *data;
694 int count;
695 int size;
696 TypePtr elements[0];
697 } BoxTypes, *BoxTypesPtr;
698
BoxTypesElements(BoxTypes * bt)699 static inline TypePtr *BoxTypesElements(BoxTypes *bt) {
700 return bt->elements;
701 }
702
BoxTypesValue(BoxTypes * bt,int e)703 static inline TypePtr BoxTypesValue(BoxTypes *bt, int e) {
704 return BoxTypesElements(bt)[e];
705 }
706
BoxTypesValueSet(BoxTypes * bt,int e,TypePtr t)707 static inline void BoxTypesValueSet(BoxTypes *bt, int e, TypePtr t) {
708 BoxTypesElements(bt)[e] = t;
709 }
710
711 extern BoxTypesPtr NewBoxTypes (int size);
712 extern int AddBoxType (BoxTypesPtr *btp, TypePtr t);
713
714 typedef struct _ref {
715 BaseValue base;
716 BoxPtr box;
717 int element;
718 } Ref;
719
720 typedef struct _structType {
721 DataType *data;
722 int nelements;
723 BoxTypesPtr types;
724 Atom atoms[0];
725 } StructType;
726
727 #define StructTypeAtoms(st) ((st)->atoms)
728
729 typedef struct _struct {
730 BaseValue base;
731 StructType *type;
732 BoxPtr values;
733 } Struct;
734
735 typedef struct _union {
736 BaseValue base;
737 StructType *type;
738 Atom tag;
739 BoxPtr value;
740 Type *types[0];
741 } Union;
742
743 typedef struct _func {
744 BaseValue base;
745 CodePtr code;
746 FramePtr staticLink;
747 BoxPtr statics;
748 } Func;
749
750 /*
751 * This is a continuation, the same structure is also used within
752 * threads, twixts and catches to hold an execution context
753 */
754
755 typedef struct _continuation {
756 union {
757 BaseValue value;
758 DataType *data;
759 } type;
760 Value value; /* accumulator */
761 InstPtr pc; /* program counter */
762 ObjPtr obj; /* reference to obj containing pc */
763 FramePtr frame; /* function call frame list */
764 StackObject *stack; /* value stack */
765 CatchPtr catches; /* handled exceptions */
766 TwixtPtr twixts; /* pending twixts */
767 } Continuation;
768
769 typedef enum _ThreadState {
770 ThreadRunning,
771 ThreadSuspended,
772 ThreadFinished
773 } ThreadState;
774
775 typedef struct _thread {
776 /*
777 * Execution continuation
778 */
779 Continuation continuation;
780 /*
781 * Currently executing jump
782 */
783 JumpPtr jump;
784 /*
785 * Thread status
786 */
787 ThreadState state;
788 int priority;
789 Value sleep;
790 int id;
791 int partial;
792 /*
793 * Lower priority threads
794 */
795 Value next;
796 } Thread;
797
798 #define PriorityMin 0
799 #define PriorityStart 100
800 #define PrioritySync 200
801 #define PriorityIo 300
802
803 typedef struct _semaphore {
804 BaseValue value;
805 int count;
806 int id;
807 } Semaphore;
808
809 /*
810 * Set the continuation at dst to that at src. Return the src
811 * continuation instruction pointer
812 */
813 InstPtr ContinuationSet (ContinuationPtr dst,
814 ContinuationPtr src);
815
816 /*
817 * Jump through a continuation, unwinding or rewinding appropriate twixt blocks
818 */
819 Value
820 ContinuationJump (Value thread, ContinuationPtr src, Value ret, InstPtr *next);
821
822 /*
823 * Mark memory referenced from a continuation,
824 */
825 void ContinuationMark (void *object);
826
827 /*
828 * Initialize a continuation to default values
829 */
830 void ContinuationInit (ContinuationPtr continuation);
831
832 #ifdef DEBUG_JUMP
833 void ContinuationTrace (char *where, Continuation *continuation, int indent);
834 void ThreadCatches (Value thread);
835 #endif
836
837 /*
838 * Hash tables. Indexed by multiple typed values
839 */
840
841 typedef const struct _HashSet {
842 HashValue entries;
843 HashValue size;
844 HashValue rehash;
845 } HashSetRec, *HashSetPtr;
846
847 /*
848 * Hash elements are stored in boxes, with three elements
849 * for each element (hash, key, value)
850 *
851 * Hash element states:
852 *
853 * key value
854 * 0 0 empty
855 * v 0 reference to uninitialized element
856 * 0 v deleted
857 * v v valid entry
858 *
859 * So:
860 * key != 0 -> hash table includes
861 * value != 0 -> hash chain includes
862 */
863
864 #define HashEltHash(e) ((e)[0])
865 #define HashEltKey(e) ((e)[1])
866 #define HashEltValue(e) ((e)[2])
867 #define HashEltSize 3
868 #define HashEltStep(e) ((e) += HashEltSize)
869 #define HashEltCopy(d,s) (((d)[0] = (s)[0]), \
870 ((d)[1] = (s)[1]), \
871 ((d)[2] = (s)[2]))
872 #define HashEltValid(e) (HashEltKey(e) != 0)
873 #define HashEltChained(e) (HashEltValue(e) != 0)
874
875 typedef struct _hashTable {
876 BaseValue base;
877 HashSetRec *hashSet;
878 HashValue count;
879 TypePtr type;
880 TypePtr keyType;
881 BoxPtr elts;
882 Value def;
883 } HashTable, *HashTablePtr;
884
885 typedef union _value {
886 BaseValue value;
887 Integer integer;
888 Rational rational;
889 Float floats;
890 String string;
891 Array array;
892 File file;
893 Ref ref;
894 Foreign foreign;
895 Struct structs;
896 Union unions;
897 Func func;
898 Thread thread;
899 Semaphore semaphore;
900 Continuation continuation;
901 HashTable hash;
902 } ValueRec;
903
904 typedef Value (*Binary) (Value, Value, int);
905
906 typedef Value (*Unary) (Value, int);
907
908 typedef Value (*Promote) (Value, Value);
909
910 typedef Value (*Coerce) (Value);
911
912 typedef int (*Hash) (Value);
913
914 #define DEFAULT_OUTPUT_PRECISION -1
915 #define INFINITE_OUTPUT_PRECISION -2
916
917 typedef Bool (*Output) (Value, Value, char format, int base, int width, int prec, int fill);
918
919 typedef ValueRep *(*TypeCheck) (BinaryOp, Value, Value, int);
920
921 struct _valueType {
922 DataType data;
923 Rep tag;
924 Binary binary[NumBinaryOp];
925 Unary unary[NumUnaryOp];
926 Promote promote;
927 Coerce reduce;
928 Output print;
929 TypeCheck typecheck;
930 Hash hash;
931 };
932
_ValueRep(Value v)933 static inline ValueRep *_ValueRep(Value v) {
934 if (ValueIsInt(v))
935 return &IntRep;
936 return v->value.type;
937 }
938
ValueTag(Value v)939 static inline Rep ValueTag(Value v) {
940 return ValueRep(v)->tag;
941 }
942
IntegerMag(Value i)943 static inline Natural *IntegerMag(Value i) {
944 return (Natural *) ((long) (i->integer.magn) & ~1);
945 }
946
IntegerSign(Value i)947 static inline Sign IntegerSign(Value i) {
948 return (Sign) ((long) (i->integer.magn) & 1);
949 }
950
951 typedef struct _boxReplace {
952 DataType *data;
953 BoxPtr new;
954 int oldstride;
955 int newstride;
956 } BoxReplace, *BoxReplacePtr;
957
958 typedef struct _box {
959 DataType *data;
960 unsigned long constant : 1;
961 unsigned long homogeneous : 1;
962 unsigned long replace : 1;
963 unsigned long nvalues : (sizeof (unsigned long) * 8) - 3;
964 union {
965 BoxTypesPtr types;
966 TypePtr type;
967 BoxReplacePtr replace;
968 } u;
969 Value values[0];
970 } Box;
971
972 #if 1
973 #define BoxCheck(box) assert (!(box)->replace)
974 #else
975 #define BoxCheck(box)
976 #endif
977
BoxElements(Box * box)978 static inline Value *BoxElements(Box *box)
979 {
980 BoxCheck(box);
981 return box->values;
982 }
983
BoxValueSet(Box * box,long e,Value v)984 static inline Value BoxValueSet(Box *box, long e, Value v) {
985 return BoxElements(box)[e] = v;
986 }
987
BoxValueGet(Box * box,long e)988 static inline Value BoxValueGet(Box *box, long e) {
989 return BoxElements(box)[e];
990 }
991
BoxConstant(Box * box,int e)992 static inline Bool BoxConstant(Box *box, int e) {
993 return box->constant;
994 }
995
_BoxReplace(Box * box)996 static inline Bool _BoxReplace(Box *box) {
997 return box->replace;
998 }
999
1000 #define BoxReplace(box) _BoxReplace(box)
1001
_BoxType(Box * box,long e)1002 static inline TypePtr _BoxType(Box *box, long e) {
1003 BoxCheck(box);
1004 if (box->homogeneous)
1005 return box->u.type;
1006 else
1007 return BoxTypesValue(box->u.types, e);
1008 }
1009
1010 #define BoxType(box, e) _BoxType(box, e)
1011
1012 extern BoxPtr NewBox (Bool constant, Bool array, int nvalues, TypePtr type);
1013 extern BoxPtr NewTypedBox (Bool array, BoxTypesPtr types);
1014 void BoxSetReplace (BoxPtr old, BoxPtr new, int oldstride, int newstride);
1015 BoxPtr BoxRewrite (BoxPtr box, int *ep);
1016
1017 typedef struct {
1018 DataType *data;
1019 int size;
1020 union {
1021 double d;
1022 double_digit dd;
1023 void *p;
1024 } values[0];
1025 } DataCache, *DataCachePtr;
1026
1027 DataCachePtr NewDataCache (int size);
1028
DataCacheValues(DataCache * vc)1029 static inline void *DataCacheValues(DataCache *vc) {
1030 return (void *) vc->values;
1031 }
1032
ArrayDims(Array * a)1033 static inline int *ArrayDims (Array *a)
1034 {
1035 return a->dims;
1036 }
1037
1038 #define ArrayLimits(a) (ArrayDims(a) + (a)->ndim)
1039 #define ArrayConstant
1040
ArrayNvalues(Array * a)1041 static inline long ArrayNvalues(Array *a) {
1042 if (a->resizable)
1043 return a->u.resize->nvalues;
1044 else
1045 return a->u.fix->nvalues;
1046 }
1047
ArrayValueBox(Array * a,long i)1048 static inline BoxPtr ArrayValueBox(Array *a, long i) {
1049 if (a->resizable)
1050 return BoxVectorBoxes(a->u.resize)[i];
1051 else
1052 return a->u.fix;
1053 }
1054
ArrayValueElt(Array * a,long i)1055 static inline int ArrayValueElt(Array *a, long i) {
1056 if (a->resizable)
1057 return 0;
1058 else
1059 return i;
1060 }
1061
ArrayType(Array * a)1062 static inline TypePtr ArrayType(Array *a) {
1063 if (a->resizable)
1064 return a->u.resize->type;
1065 else
1066 return a->u.fix->u.type;
1067 }
1068
1069 #define ArrayValue(a,i) (BoxValue(ArrayValueBox(a,i),ArrayValueElt(a,i)))
1070 #define ArrayValueGet(a,i) (BoxValueGet(ArrayValueBox(a,i),ArrayValueElt(a,i)))
1071
ArrayValueSet(Array * a,long i,Value v)1072 static inline void ArrayValueSet(Array *a, long i, Value v)
1073 {
1074 BoxValueSet(ArrayValueBox(a,i),ArrayValueElt(a,i), v);
1075 }
1076
1077 void
1078 RefRewrite (Value r);
1079
RefCheck(Value r)1080 static inline void RefCheck(Value r) {
1081 if (BoxReplace(r->ref.box))
1082 RefRewrite(r);
1083 }
1084
RefValueSet(Value r,Value v)1085 static inline void RefValueSet(Value r, Value v) {
1086 RefCheck(r);
1087 BoxValueSet(r->ref.box, r->ref.element, v);
1088 }
1089
RefValueGet(Value r)1090 static inline Value RefValueGet(Value r) {
1091 RefCheck(r);
1092 return BoxValueGet(r->ref.box, r->ref.element);
1093 }
1094
RefType(Value r)1095 static inline TypePtr RefType (Value r) {
1096 RefCheck(r);
1097 return BoxType(r->ref.box, r->ref.element);
1098 }
1099
RefConstant(Value r)1100 static inline Bool RefConstant(Value r) {
1101 return BoxConstant(r->ref.box, r->ref.element);
1102 }
1103
1104 Value NewInteger (Sign sign, Natural *mag);
1105 Value NewIntInteger (int value);
1106 Value NewSignedDigitInteger (signed_digit d);
1107 Value NewRational (Sign sign, Natural *num, Natural *den);
1108 Value NewIntRational (int value);
1109 Value NewIntegerRational (Integer *);
1110 Value NewFloat (Fpart *mant, Fpart *exp, unsigned prec);
1111 Value NewIntFloat (int i, unsigned prec);
1112 Value NewIntegerFloat (Integer *i, unsigned prec);
1113 Value NewNaturalFloat (Sign sign, Natural *n, unsigned prec);
1114 Value NewRationalFloat (Rational *r, unsigned prec);
1115 Value NewValueFloat (Value av, unsigned prec);
1116 Value NewDoubleFloat (double d);
1117 Value NewContinuation (ContinuationPtr continuation, InstPtr pc);
1118 Value NewForeign (const char *id, void *data, void (*mark)(void *data), void (*free)(void *data));
1119
1120 unsigned FpartLength (Fpart *a);
1121
1122 #define DEFAULT_FLOAT_PREC 256
1123 #define REF_CACHE_SIZE 1031
1124
1125 extern DataCachePtr refCache;
1126
1127 Value NewString (long length);
1128 Value NewStrString (const char *);
1129 Value NewCharString (int c);
1130 Value NewArray (Bool constant, Bool resizable, TypePtr type, int ndim, int *dims);
1131 void ArrayResize (Value av, int dim, int size);
1132 void ArraySetDimensions (Value av, int *dims);
1133 Value NewHash (Bool constant, TypePtr keyType, TypePtr valueType);
1134 Value HashGet (Value hv, Value key);
1135 void HashSet (Value hv, Value key, Value value);
1136 void HashSetDef (Value hv, Value def);
1137 Value HashKeys (Value hv);
1138 Value HashRef (Value hv, Value key);
1139 Value HashTest (Value hv, Value key);
1140 void HashDelete (Value hv, Value key);
1141 Value HashCopy (Value hv);
1142
1143 Value NewFile (int fd);
1144 Value NewRefReal (BoxPtr box, int element, Value *re);
1145 char *StringNextChar (char *src, unsigned *dst, long *length);
1146 int StringPutChar (unsigned c, char *dest);
1147 int StringLength (char *src, long length);
1148 int StringCharSize (unsigned c);
1149 unsigned StringGet (char *src, long len, int i);
1150 char *StrzPart (Value, char *error);
1151
1152 static inline Value
NewRef(BoxPtr box,int element)1153 NewRef (BoxPtr box, int element)
1154 {
1155 int c = (PtrToUInt (&BoxElements(box)[element])) % REF_CACHE_SIZE;
1156 Value *re = (Value *) (DataCacheValues(refCache)) + c;
1157 Value ret = *re;
1158
1159 if (ret && ret->ref.box == box && ret->ref.element == element)
1160 {
1161 REFERENCE (ret);
1162 return ret;
1163 }
1164 return NewRefReal (box, element, re);
1165 }
1166
1167 Value NewStruct (StructType *type, Bool constant);
1168 StructType *NewStructType (int nelements);
1169 Type *BuildStructType (int nelements, ...);
1170 Type *StructMemType (StructType *st, Atom name);
1171 Value StructMemRef (Value sv, Atom name);
1172 Value StructMemValue (Value sv, Atom name);
1173 Value NewUnion (StructType *type, Bool constant);
1174 Type *BuildUnionType (int nelements, ...);
1175 Type *BuildEnumType (int nelements, ...);
1176 Value UnionValue (Value uv, Atom name);
1177 Value UnionRef (Value uv, Atom name);
1178 Type *BuildArrayType (Type *type, int ndim, ...);
1179
1180 Value BinaryOperate (Value av, Value bv, BinaryOp operator);
1181 Value UnaryOperate (Value v, UnaryOp operator);
1182 Value NumericDiv (Value av, Value bv, int expandOk);
1183 Value NumericMod (Value av, Value bv, int expandOk);
1184
1185 # define OK_TRUNC 1
1186
1187 extern Value Blank, Elementless, Void, TrueVal, FalseVal;
1188
1189 # define True(v) ((v) == TrueVal)
1190 # define False(v) ((v) != TrueVal)
1191
1192 Value FileGetError (int err);
1193 Value FileGetErrorMessage (int err);
1194 int FileInput (Value);
1195 int FileOutput (Value, char);
1196 void FileUnput (Value, unsigned char);
1197 int FileInchar (Value);
1198 int FileOutchar (Value, int);
1199 void FileUnchar (Value, int);
1200 Value FileCreate (int fd, int flags);
1201 int FileFlush (Value, Bool block);
1202 int FileClose (Value);
1203 Value FileStringRead (char *string, int len);
1204 Value FileStringWrite (void);
1205 Value FileStringString (Value file);
1206 void FileSetFd (int fd), FileResetFd (int fd);
1207 Bool FileIsReadable (int fd);
1208 Bool FileIsWritable (int fd);
1209 void FilePutsc (Value, char *, long length);
1210 void FilePuts (Value, char *);
1211 void FilePutDoubleDigitBase (Value file, double_digit a, int base);
1212 void FilePutUIntBase (Value file, unsigned int a, int base);
1213 void FilePutIntBase (Value file, int a, int base);
1214 void FilePutInt (Value, int);
1215 int FileStringWidth (char *string, long length, char format);
1216 void FilePutString (Value f, char *string, long length, char format);
1217 void FilePutRep (Value f, Rep tag, Bool minimal);
1218 void FilePutClass (Value f, Class storage, Bool minimal);
1219 void FilePutPublish (Value f, Publish publish, Bool minimal);
1220 void FilePutType (Value f, Type *t, Bool minimal);
1221 void FilePutBaseType (Value f, Type *t, Bool minimal);
1222 void FilePutSubscriptType (Value f, Type *t, Bool minimal);
1223 Value FileFilter (char *program, char *args[], Value filev, int *errp);
1224 Value FileFopen (char *name, char *mode, int *errp);
1225 Value FileReopen (char *name, char *mode, Value file, int *errp);
1226 Value FileMakePipe (int *errp);
1227 void FilePutArgType (Value f, ArgType *at);
1228 int FileStatus (Value file);
1229 void FileCheckBlocked (Bool block);
1230 void FileSetBlocked (Value file, int flag);
1231 void FilePrintf (Value, char *, ...);
1232 void FileVPrintf (Value, char *, va_list);
1233 void FileSetBuffer (Value file, int buf);
1234
1235 extern Bool anyFileWriteBlocked;
1236 extern Bool anyPipeReadBlocked;
1237
1238 extern BoxPtr FileStdinBox, FileStdoutBox, FileStderrBox;
1239
1240 #define FileStdin BoxValueGet(FileStdinBox, 0)
1241 #define FileStdout BoxValueGet(FileStdoutBox, 0)
1242 #define FileStderr BoxValueGet(FileStderrBox, 0)
1243
1244 typedef Value (*BinaryFunc) (Value, Value);
1245 typedef Value (*UnaryFunc) (Value);
1246
1247 #define Plus(av,bv) BinaryOperate (av, bv, PlusOp)
1248 #define Minus(av,bv) BinaryOperate (av, bv, MinusOp)
1249 #define Times(av,bv) BinaryOperate (av, bv, TimesOp)
1250 #define Divide(av,bv) BinaryOperate (av, bv, DivideOp)
1251 #define Div(av,bv) BinaryOperate (av, bv, DivOp)
1252 #define Mod(av,bv) BinaryOperate (av, bv, ModOp)
1253 #define Less(av,bv) BinaryOperate (av, bv, LessOp)
1254 #define Equal(av,bv) BinaryOperate (av, bv, EqualOp)
1255 #define Land(av,bv) BinaryOperate (av, bv, LandOp)
1256 #define Lor(av,bv) BinaryOperate (av, bv, LorOp)
1257
1258 int logbase2(int a);
1259
1260 Value Greater (Value, Value), LessEqual (Value, Value);
1261 Value GreaterEqual (Value, Value), NotEqual (Value, Value);
1262 Value Not (Value);
1263 Value Negate (Value), Floor (Value), Ceil (Value);
1264 Value Truncate (Value);
1265 Value Round (Value);
1266 Value Pow (Value, Value), Factorial (Value), Reduce (Value);
1267 Value ShiftL (Value, Value), ShiftR (Value, Value);
1268 Value Gcd (Value, Value);
1269 #undef GCD_DEBUG
1270 #ifdef GCD_DEBUG
1271 Value Bdivmod (Value av, Value bv);
1272 Value KaryReduction (Value av, Value bv);
1273 #endif
1274 Value Lxor(Value, Value), Lnot (Value);
1275 Value Popcount(Value);
1276 Bool Print (Value, Value, char format, int base, int width, int prec, int fill);
1277 void PrintError (char *s, ...);
1278 HashValue HashCrc32 (unsigned char *bytes, int nbytes);
1279 Value CopyMutable (Value v);
1280
1281 static inline Value
Copy(Value v)1282 Copy (Value v)
1283 {
1284 if (v && Mutablep (ValueTag(v)))
1285 return CopyMutable (v);
1286 return v;
1287 }
1288
1289 Value ValueEqual (Value a, Value b, int expandOk);
1290
1291 Value ValueHash (Value a);
1292
1293 /*
1294 * There are two kinds of signals:
1295 *
1296 * aborting current instruction should be suspended
1297 * non-aborting current instruction should be completed
1298 *
1299 * SIGIO and SIGALRM are non-aborting; otherwise computation would probably
1300 * never make progress
1301 *
1302 * SIGINTR is aborting
1303 * All internal signals are aborting
1304 *
1305 * An aborting signal marks 'aborting, signaling' and itself, this way
1306 * low-level computations can check 'aborting' and the interpreter can
1307 * check 'signaling' and then check the individual signals
1308 */
1309
1310 extern volatile Bool aborting; /* abort current instruction */
1311 extern volatile Bool signaling; /* some signal is pending */
1312
1313 /*
1314 * Any signal state set by an signal handler must be volatile
1315 */
1316
1317 extern volatile Bool signalInterrupt; /* keyboard interrupt */
1318 extern volatile Bool signalTimer; /* timer interrupt */
1319 extern volatile Bool signalIo; /* i/o interrupt */
1320 extern volatile Bool signalProfile; /* vtimer interrupt */
1321 extern volatile Bool signalChild; /* sub process interrupt */
1322
1323 #define SetSignalInterrupt()(aborting = signaling = signalInterrupt = True)
1324 #define SetSignalTimer() (signaling = signalTimer = True)
1325 #define SetSignalIo() (signaling = signalIo = True)
1326 #define SetSignalProfile() (signaling = signalProfile = True)
1327 #define SetSignalChild() (signaling = signalChild = True)
1328
1329 /*
1330 * Any signal state set by regular code doesn't need to be volatile
1331 */
1332
1333 extern Bool signalSuspend; /* current thread suspend */
1334 extern Bool signalFinished; /* current thread done */
1335 extern Bool signalException; /* current thread exception pending */
1336 extern Bool signalError; /* current thread run time error */
1337
1338 #define SetSignalSuspend() (aborting = signaling = signalSuspend = True)
1339 #define SetSignalFinished() (aborting = signaling = signalFinished = True)
1340 #define SetSignalException()(aborting = signaling = signalException = True)
1341 #define SetSignalError() (aborting = signaling = signalError = True)
1342
1343 int
1344 NaturalToInt (Natural *n);
1345
1346 double_digit
1347 NaturalToDoubleDigit(Natural *n);
1348
1349 int IntegerToInt (Integer *i);
1350
1351 int
1352 IntegerFitsSignedDigit(Integer *i);
1353
1354 signed_digit
1355 IntegerToSignedDigit(Integer *i);
1356
1357 int IntPart (Value, char *error);
1358
1359 int BoolPart (Value, char *error);
1360
1361 signed_digit
1362 SignedDigitPart(Value v, char *error);
1363
1364 double DoublePart (Value av, char *error);
1365
1366 Bool Zerop (Value);
1367 Bool Negativep (Value);
1368 Bool Evenp (Value);
1369
1370 int ArrayInit (void);
1371 int AtomInit (void);
1372 int FileInit (void);
1373 int IntInit (void);
1374 int HashInit (void);
1375 int NaturalInit (void);
1376 int IntegerInit (void);
1377 int RationalInit (void);
1378 int FpartInit (void);
1379 int StringInit (void);
1380 int StructInit (void);
1381 int RefInit (void);
1382 int ForeignInit (void);
1383 int ValueInit (void);
1384
oneNp(Natural * n)1385 static inline Bool oneNp (Natural *n) {
1386 return n->length == 1 && NaturalDigits(n)[0] == 1;
1387 }
1388
zeroNp(Natural * n)1389 static inline Bool zeroNp (Natural *n) {
1390 return n->length == 0;
1391 }
1392
1393 void ferr(int);
1394 void ignore_ferr (void);
1395
1396 #endif /* _VALUE_H_ */
1397