/* tags.h                               Copyright (C) Codemist 1990-2007 */

/*
 *   Data-structure and tag bit definitions, also common C macros
 *   for Lisp implementation.
 *
 */

/*
 * This code may be used and modified, and redistributed in binary
 * or source form, subject to the "CCL Public License", which should
 * accompany it. This license is a variant on the BSD license, and thus
 * permits use of code derived from this in either open and commercial
 * projects: but it does require that updates to this code be made
 * available back to the originators of the package.
 * Before merging other code in with this or linking this code
 * with other packages or libraries please check that the license terms
 * of the other material are compatible with those of this.
 */

/* Signature: 17cc1c54 29-Dec-2007 */


#ifndef header_tags_h
#define header_tags_h 1

/*
 * These days I have make autoconf stuff check to see if the standard
 * header that defines known-size integer types is available. And then
 * in "headers.h" I patch things up for old systems where it is not present,
 * at least as best I can manage.
 */

#ifndef HAVE_INT32_T
#error This system needs a 32-bit integer type.
#endif

#define SIXTY_FOUR_BIT (sizeof(intptr_t) == 8)

typedef int                 CSLbool;

#define YES                 1
#define NO                  0

/*
 * I allocate memory (using malloc()) in CSL_PAGE_SIZE chunks.
 * This was first implemented for the benefit of 16-bit machines
 * (in particular MSDOS/286) but now seems generally reasonable.  The biggest
 * menace about it is that it limits the size of the largest vector I can ever
 * allocate - and this (as of the time of this comment) limits the size of
 * the symbol table (object list).
 *
 * My default at present is to use PAGE_BITS=22, which leads to 4 Mbyte pages.
 * I use that size on both 32 and 64-bit machines, which will mean that
 * 32 bit systems can support vectors that are longer than will fit into
 * a 64-bit system.
 *
 * Once upon a time I used 16-bit pages. For small hardware (such as a PDA)
 * I sometimes make my Makefile downgrade this to use 18-bit (256Kbyte)
 * pages to save some waste.
 */

#ifndef PAGE_BITS
#  define PAGE_BITS             22
#endif /* PAGE_BITS */

#define PAGE_POWER_OF_TWO       (((uint32_t)1) << PAGE_BITS)
/*
 * When I come to allocate memory I do so in chunks that are a little less
 * than the power of two suggested here, to allow for malloc() header
 * blocks etc.
 */
#define CSL_PAGE_SIZE           (PAGE_POWER_OF_TWO - 256U)

/*
 * On 64-bit systems I will limit myself to 20 Gbyte, while on 32-bit
 * ones the limit is around 2 Gbyte and in reality will usually be
 * rather less than that.
 */
#ifndef MAX_HEAPSIZE
#  define MAX_HEAPSIZE       (SIXTY_FOUR_BIT ? 20480 : 2048)
#endif /* MAX_HEAPSIZE */

#ifndef MAX_BPSSIZE
/*
 * Note once again that 64 (megabytes) is the largest valid value that can be
 * used here.  But also note that 64 Mbytes of bytecodes would be a pretty
 * large program!
 */
#  define MAX_BPSSIZE           64
#endif /* MAX_BPSSIZE */

#define MEGABYTE                ((uint32_t)0x100000U)

#if PAGE_BITS >= 20
#define MAX_PAGES               (MAX_HEAPSIZE >> (PAGE_BITS-20))
#define MAX_BPS_PAGES           (MAX_BPSSIZE >> (PAGE_BITS-20))
#else
#define MAX_PAGES               (MAX_HEAPSIZE << (20-PAGE_BITS))
#define MAX_BPS_PAGES           (MAX_BPSSIZE << (20-PAGE_BITS))
#endif

#define MAX_NATIVE_PAGES        MAX_BPS_PAGES

#define PAGE_MASK               ((((uint32_t)1) << (32-PAGE_BITS)) - 1)
#define OFFSET_MASK             ((((uint32_t)1) << PAGE_BITS) - 1)

#define CSL_IGNORE(x)           (x = x)

/*
 * Windows seems to say it can use file names up to 260 chars, Unix and
 * the like may not even have that limit, but I will assume something here.
 * There must be a number of cases of potential buffer overflow throughout
 * my code caused by this fixed limit.
 */
#define LONGEST_LEGAL_FILENAME 1024

/*
 * The following values relate to the identification of floating
 * point representations.  Note that they all fit in a byte. Actually these
 * days I think I will INSIST that the basic representation is as per IEEE,
 * but there can still be word and byte-order issues.
 * I am going to assume that if the byte order if "flipped" in a double
 * then it will be in a float too. And I will not support any really
 * odd cases where bits are messed around with halfword by halfword!
 */

#define FP_WORD_ORDER 0x01
#define FP_BYTE_ORDER 0x02
#define FP_MASK       0xff


/*
 * General objects in Lisp are represented as pointer-sized integers
 * and the type Lisp_Object reflects this representation and
 * not the elaborate tagged union that at some other level exists.
 * If I could use "void *" for this type that might give me a bit more
 * security since not much can be done with a "void *" object - in particular
 * it can not participate in arithmetic.  But when I do that I run into
 * trouble in protected mode on a PC if I have items of type Lisp_Object
 * that are not valid pointers. I suspect that the same used to be
 * the case on a Motorola 68000 with address and data registers.
 */
/*
 * Sometimes the pointer-sized integer will be 64-bits wide, and will be the
 * data type for the type Lisp_Object. A result will be that anywhere in
 * the code where I am sloppy about putting such an object into an int32_t
 * I will have trouble, and anywhere that I use absolute numeric offsets
 * instead of multiples of sizeof(Lisp_Object) there can be pain.
 * Coping with this means I have to be careful about integer constants that
 * could fit into 64 but not 32-bits.
 */

typedef intptr_t Lisp_Object;


/*
 * The macro CELL had better have either the value 4 or 8. It is the
 * size of the basic unit of memory within which CSL works.
 */

#define CELL sizeof(Lisp_Object)

/*
 * Lisp_Object is a datatype where the low 3 bits are used as tags -
 * this idea works provided all memory addresses needed can be kept
 * doubleword aligned.  The main tag allocation is documented here.
 */

#define TAG_BITS        7

#define TAG_CONS        0   /* Cons cells (and for Common Lisp, the special */
                            /* case of NIL */
#define TAG_FIXNUM      1   /* 28-bit integers */
#define TAG_ODDS        2   /* Char constants, BPS addresses, vechdrs etc */
#ifdef COMMON
#define TAG_SFLOAT      3   /* Short float, 28 bits of immediate data */
#endif /* COMMON */
#define TAG_SYMBOL      4   /* Symbols (maybe except for NIL) */
#define TAG_NUMBERS     5   /* Bignum, Rational, Complex */
#define TAG_VECTOR      6   /* Regular Lisp vectors (except BPS maybe?) */
#define TAG_BOXFLOAT    7   /* Boxed floats */

/*
 * For each of the above tag classes I have a bunch of low-level
 * operations that need support - including type identification
 * predicates and conversions to and from native C formats.
 */

#define fixnum_of_int(x)    ((Lisp_Object)(TAG_FIXNUM + (((int32_t)(x)) << 4)))
/*
 * The multiple casts here are (a) to ensure that the shift is done
 * treating x as a signed value and (b) to stress that the shift is
 * done in an integer context. Note also that I would with a 32-bit
 * value here even on 64-bit machines. That is wasteful, but adapting to
 * use all the bits is a bigger change than I am prepared to contemplate
 * just now.
 */
#ifdef SIGNED_SHIFTS_ARE_LOGICAL
/* 
 * Beware - arg evaluated several time in this case. Also
 * note that even if I am using a 64-bit machine this turns a 64-bit
 * LispObject into a 32-bit integer
 */
#define int_of_fixnum(x)    ((int32_t)(((int32_t)(x)) < 0 ?           \
                             (((int32_t)(x))>>4) | (-0x10000000) :  \
                             (((int32_t)(x))>>4)))
#else /* SIGNED.. */
/*
 * Note that for 64-bit machines I expect the top 32 bits of a fixnum 
 * all to be copies of the sign bit. Of course I might imagine changing that
 * sometime later but for now it is the only reasonable way forward.
 */
#define int_of_fixnum(x)    ((int32_t)(((int32_t)(x)) >> 4))
#endif /* SIGNED .. */

/*
 * The garbage collector needs a spare bit in EVERY word...
 */

#define GC_BIT_I        8               /* Used with FIXNUM, CHAR, SFLOAT */
#define GC_BIT_H        8               /* Used in Header words */

#define GC_BIT_P        ((intptr_t)~((~(uintptr_t)0) >> 1))
/*
 * The above curious definition of GC_BIT_P is intended to ensure that
 * it looks like a negative value. This matters a lot if there is some
 * 64-bit arithmetic lurking somewhere, because then what goes on in the
 * upper 32 bits can come and bite me.  I will try to avoid trouble by
 * having all constants in this code written in a way that avoids any
 * need for explicit 'L' suffices. So this one goes
 *      00000000      0000000000000000   zero, cast to uintptr_t
 *      ffffffff      ffffffffffffffff   complement
 *      7fffffff      7fffffffffffffff   shift right one, NB unsigned
 *      80000000      8000000000000000   complement again, and cast to signed!
 * I really hope that the compiler processes this constant expression at
 * compile time, and that it gets the calculation right!
 */

/*
 * Here I assume that all valid pointers EITHER have top bit zero OR have
 * top bit one.  If this is so I can flip the top bit in a pointer to mark
 * things for the garbage collector.  Beware, I suppose, stack-allocated
 * objects on a VAX.  But note that garbage collection is only really
 * interested in the heap, which can probably be kept within one half of
 * the address space.  The nastiest case I have come across so far is
 * the Intel 80x86 where addresses spread over all 32 bits of a long int,
 * in a rather wasteful way.  For that very special machine I have to
 * invent specialist storage management schemes!
 *
 * [November 2003] Note well that many Linux systems are configured with
 * 3G of user space and 1G of systerm space within the 4G address map of a
 * 32-bit architecture. This can cause it to seem as if over 2G of memory
 * can be issued to the user. It also means that when amounts of memory
 * around a Gbyte are being allocated just where in the memory map things
 * are gets jolly uncertain and delicate. Specifically it may depend on the
 * excat version of Linux that you run. It all feels a big misery to me.
 * using that top bit could be held to be a mistake!
 */

#define is_marked_i(w)      (((int)(w) & GC_BIT_I) != 0)

/*
 * I assume that in any one run of CSL either all (malloc)
 * addresses have their top bit set OR all have their top bit clear, but
 * I can not predict in advance which case will apply.  This miserable
 * state arises with Win32 - under Windows-NT addresses are in the range
 * 0 to 0x7fffffff, while the same binary executing under Win32s has
 * addresses in the range 0x80000000 to 0xffffffff.
 * Note that many Linux (and maybe other) systems use the top 1G of a
 * 4G space for system, with the lower 3G for user space. Some will let
 * malloc return space above or below the 2G mark in a way that the user can
 * not easily control. Those worried need to move to 64 bit machines soon.
 */

extern Lisp_Object address_sign;  /* 0, 0x80000000 or 0x8000000000000000 */
#define is_marked_p(w)      (((Lisp_Object)(w) - address_sign) < 0)
#define clear_mark_bit_p(w) (((Lisp_Object)(w) & ~GC_BIT_P) + \
                              address_sign)

#define flip_mark_bit_i(w)  ((Lisp_Object)(w) ^ GC_BIT_I)
#define flip_mark_bit_h(w)  ((Header)(w) ^ GC_BIT_H)
#define flip_mark_bit_p(w)  ((Lisp_Object)(w) ^ GC_BIT_P)
#define is_marked_h(w)      (((int)(w) & GC_BIT_H) != 0)

/*
 * Exceptions are marked by setting a bit in NIL.  The following macros
 * provide an abstraction of this interface.  At one stage I used the
 * most significant bit in nil, but now for various reasons I have concluded
 * that it is nicer to use the least significant bit.
 */
#define exception_pending() (((int)nil & 1) != 0)
#define flip_exception()    (nil = C_nil = (nil ^ 1))

#define ignore_exception() \
   do { nil = C_nil; if (exception_pending()) flip_exception(); } while (0)

#define set_mark_bit_h(h)   ((Header)(h) | GC_BIT_H)
#define clear_mark_bit_h(h) ((Header)(h) & ~GC_BIT_H)
#define set_mark_bit_i(h)   ((Lisp_Object)(h) | GC_BIT_I)
#define clear_mark_bit_i(h) ((Lisp_Object)(h) & ~GC_BIT_I)

#define is_cons(p)   ((((int)(p)) & TAG_BITS) == TAG_CONS)
#define is_fixnum(p) ((((int)(p)) & TAG_BITS) == TAG_FIXNUM)
#define is_odds(p)   ((((int)(p)) & TAG_BITS) == TAG_ODDS) /* many subcases */
#ifdef COMMON
#define is_sfloat(p) ((((int)(p)) & TAG_BITS) == TAG_SFLOAT)
#endif /* COMMON */
#define is_symbol(p) ((((int)(p)) & TAG_BITS) == TAG_SYMBOL)
#define is_numbers(p)((((int)(p)) & TAG_BITS) == TAG_NUMBERS)
#define is_vector(p) ((((int)(p)) & TAG_BITS) == TAG_VECTOR)
#define is_bfloat(p) ((((int)(p)) & TAG_BITS) == TAG_BOXFLOAT)

#ifdef COMMON
/*
 * The next two lines reveal a possible cause of great confusion -
 * but one that is motivated by the desire that car/cdr should be
 * cheap to implement.  is_cons detects cons cells OR nil, and
 * is_symbol detects symbols EXCEPT nil.  The following two macros
 * implement the tests that probably seem more natural.
 */

#define consp(p)     (is_cons(p) && (p) != nil)
#define symbolp(p)   (is_symbol(p) || (p) == nil)
#else /* COMMON */
/* In Standard Lisp mode I tag nil as a symbol, and life is easier */
#define consp(p)     is_cons(p)
#define symbolp(p)   is_symbol(p)
#endif /* COMMON */

/*
 * The next definition is fun!  In Common Lisp mode I want (car nil) to
 * be legal, and that is some of the motivation for tagging NIL as if
 * it had been a cons cell.  In Standard Lisp (car nil) is invalid.
 * I consider it important to make this test fast, which is why I have
 * made it just use the tag field of a value. There is a HORRID MESS whereby
 * on 64-bit machines the general low-bit tagging of symbols will mean that
 * access to NIL as a symbol would give problems because of NIL's tag as
 * a cons cell (on 32-bit systems I get away with it!). This is handled
 * later on by putting address masks in all symbol-component access in the
 * hard case.
 */
#define car_legal(p) is_cons(p)

/*
 * The tag codes have been selected so that various useful tests
 * can be done especially cheaply - here are some of those
 * composite tests.
 */

#define is_number(p) ((((int)(p)) & 1) != 0) /* Any numeric type */
#define is_float(p)  ((((int)(p)) & 3) == 3) /* Big or small float */

/*
 * immed_or_cons is a rather funny case, in that it includes
 * the ODDS tag, which may include segment/offset addresses of BPS
 * or environment vectors.  Anyway, whatever else, the immed_() test
 * indicates something that does not contain a natural direct C
 * pointer.
 */

#define is_immed_or_cons(p) ((((int)(p)) & 4) == 0)

typedef struct Cons_Cell
{
    Lisp_Object car;
    Lisp_Object cdr;
} Cons_Cell;

#ifdef MEMORY_TRACE

/*
 * The IDEAL here would be that every time I reference memory I would
 * call memory_reference() to record this fact. In fact I have changed
 * the most important Lisp data-structure access macros to do this, but
 * not all of them. For instance in a first pass I did not consider it
 * worth altering the code that inspects rational and complex numbers!
 * Any code that at the C level uses "*" directly will also not get
 * reported.
 */

extern Cons_Cell *memory_reference(intptr_t p);
extern char *cmemory_reference(intptr_t p);
extern void identify_page_types();
extern long int car_counter;
extern unsigned long int car_low, car_high;

#define qcar(p) (memory_reference((intptr_t)p)->car)
#define qcdr(p) (memory_reference((intptr_t)p)->cdr)

#else /* MEMORY_TRACE */

#define qcar(p) (((Cons_Cell *) (p))->car)
#define qcdr(p) (((Cons_Cell *) (p))->cdr)

#endif /* MEMORY_TRACE */

/*
 * car32(p) refers to the 32-bit integer pointed at by p. It is
 * used to cope with various bits of junk at the start and end of
 * "pages" of memory where (eg) the amount of the page that is in
 * use needs to be recorded.
 */

#define car32(p) (*(int32_t *)(p))

typedef Lisp_Object Special_Form(Lisp_Object, Lisp_Object);

typedef Lisp_Object one_args(Lisp_Object, Lisp_Object);
typedef Lisp_Object two_args(Lisp_Object, Lisp_Object, Lisp_Object);
typedef Lisp_Object MS_CDECL n_args(Lisp_Object, int, ...);


/*
 * Headers are also Lisp_Objects, but I give them a separate typedef
 * name to help me keep their identity separate.  There is only any
 * chance of headers and other objects getting confused during
 * garbage collection, and the code there has to be rather on the
 * careful side.  By making Headers unsigned I help the length
 * calculation on them.
 */

typedef uintptr_t Header;

/*
 * An object can be up to 4 Mbytes long, and has 12 bits of tag + GC info
 * in its header word.  All header words have TAG_ODDS in their low order
 * 4 bits, then 6 more bits that identify what sort of object is being
 * headed.  The remaining 22 bits give the length (in bytes) of the
 * active part of the object.  Note well that this really is a limitation
 * on the largest size of an object, and it prevents me from having
 * vectors or bignums larger than 4 Mbytes regardless of the "page"
 * structure of my memory. Well on 64-but machine I will be
 * able to relax that sometime in the future - but not just now please. So
 * observe that right now I limit lengths to 32-bit values. I guess
 * that actually since a Header is 64-bits in the 64-bit case this
 * still lets me have objects up to 4 Gbytes large...
 */

#define header_mask          0x3f0
#define type_of_header(h)    (((unsigned int)(h)) & header_mask)
#define length_of_header(h)  (((uint32_t)(h)) >> 10)

/* Values for the type field in a header */

/*
 * Symbols are so important that they have 26 bits used to sub-classify them.
 * These are used by the interpreter to identify special variables, special
 * forms, and those symbols which are defined as macros.  The bits live where
 * other items would store a length, but since all symbol headers are the
 * same size an explicit length field is not necessary - but missing one out
 * means that I have to do a special check for the SYMBOL case whenever I
 * scan the vector heap, which is a bit messy.
 */

#define TYPE_SYMBOL         0x00000010
#define  SYM_SPECIAL_VAR    0x00000040  /* (fluid '(xxx))  */
#define  SYM_GLOBAL_VAR     0x00000080  /* (global '(xxx)) */
#define  SYM_SPECIAL_FORM   0x00000100  /* eg. COND, QUOTE */
#define  SYM_MACRO          0x00000200  /* (putd 'xxx 'macro ...) */
#define  SYM_C_DEF          0x00000400  /* has definition from C kernel */
#define  SYM_CODEPTR        0x00000800  /* just carries code pointer */
#define  SYM_ANY_GENSYM     0x00001000  /* gensym, printed or not */
#define  SYM_TRACED         0x00002000
#define  SYM_FASTGET_MASK   0x000fc000  /* used to support "fast" gets */
#define  SYM_FASTGET_SHIFT  14
/*
 * In Common Lisp mode I use the rest of the header to help speed up
 * test for the availability of a symbol in a package (while I am printing).
 * In Standard Lisp mode I only allocate a print-name to a gensym when I
 * first print it, so I have a bit that tells me when a gensym is still
 * not printed.
 */
#ifdef COMMON
#define  SYM_EXTERN_IN_HOME 0x00100000  /* external in its home package */
#define  SYM_IN_PACKAGE     0xffe00000  /* availability in 11 packages */
#define  SYM_IN_PKG_SHIFT   23
#define  SYM_IN_PKG_COUNT   11
#else /* COMMON */
#define  SYM_UNPRINTED_GENSYM 0x00100000/* not-yet-printed gensym */
#endif /* COMMON */

#define symhdr_length       ((sizeof(Symbol_Head) + 7) & ~7)
#define is_symbol_header(h) (((int)h & 0x30) == TYPE_SYMBOL)
#define header_fastget(h)   (((h) >> SYM_FASTGET_SHIFT) & 0x3f)

#define TYPE_BIGNUM         0x020   /* low 2-bits = '10' for numbers */
#ifdef COMMON
#define TYPE_RATNUM         0x060
#define TYPE_COMPLEX_NUM    0x0a0
#define TYPE_SINGLE_FLOAT   0x120
#endif /* COMMON */
#define TYPE_DOUBLE_FLOAT   0x160
#ifdef COMMON
#define TYPE_LONG_FLOAT     0x1a0
#endif /* COMMON */

#ifdef MEMORY_TRACE
#define numhdr(v) (*(Header *)memory_reference((intptr_t)((char *)(v) - \
                                               TAG_NUMBERS)))
#define flthdr(v) (*(Header *)memory_reference((intptr_t)((char *)(v) - \
                                               TAG_BOXFLOAT)))
#else
#define numhdr(v) (*(Header *)((char *)(v) - TAG_NUMBERS))
#define flthdr(v) (*(Header *)((char *)(v) - TAG_BOXFLOAT))
#endif

#define is_numbers_header(h) (((int)(h) & 0x330) == 0x020)
#define is_boxfloat_header(h)(((int)(h) & 0x330) == 0x120)

#ifdef COMMON
/*
 * The following tests are valid provided that n is already known to
 * have tag TAG_NUMBERS, i.e. it is a bignum, ratio or complex.
 */
#define is_ratio(n) \
    (type_of_header(numhdr(n)) == TYPE_RATNUM)

#define is_complex(n) \
    (type_of_header(numhdr(n)) == TYPE_COMPLEX_NUM)

#endif /* COMMON */

#define is_bignum_header(h) (type_of_header(h) == TYPE_BIGNUM)

#define is_bignum(n) is_bignum_header(numhdr(n))

/*
 * I very much hope that sensible C compilers will observe that the
 * value SIXTY_FOUR_BIT is a constant (but I am not allowed to know its
 * value at preprocessor time) and so will simplify this apparent test
 * so that at run-time you just use the value 2 or 3.
 */
#define ADDRESS_SHIFT (SIXTY_FOUR_BIT ? 3 : 2)

#ifdef MEMORY_TRACE
#define vechdr(v)  (*(Header *)memory_reference((intptr_t)((char *)(v) - \
                               TAG_VECTOR)))
#define elt(v, n)  (*(Lisp_Object *)memory_reference((intptr_t)((char *)(v) + \
                               (CELL-TAG_VECTOR) + \
                               (((intptr_t)(n))<<ADDRESS_SHIFT))))
#define celt(v, n) (*cmemory_reference((intptr_t)((char *)(v) + \
                               (CELL-TAG_VECTOR)+((intptr_t)(n)))))
#define ucelt(v, n) (*(unsigned char *)cmemory_reference( \
                               (intptr_t)((char *)(v) + \
                               (CELL-TAG_VECTOR)+((intptr_t)(n)))))
#define scelt(v, n) (*(signed char *)cmemory_reference( \
                               (intptr_t)((char *)(v) + \
                               (CELL-TAG_VECTOR)+((intptr_t)(n)))))
#else /* MEMORY_TRACE */

#define vechdr(v)  (*(Header *)((char *)(v) - TAG_VECTOR))
#define elt(v, n)  (*(Lisp_Object *)((char *)(v) + \
                               (CELL-TAG_VECTOR) + \
                               (((intptr_t)(n))<<ADDRESS_SHIFT)))
#define celt(v, n) (*((char *)(v) + (CELL-TAG_VECTOR)+((intptr_t)(n))))
#define ucelt(v, n) (*((unsigned char *)(v) + (CELL-TAG_VECTOR)+((intptr_t)(n))))
#define scelt(v, n) (*((signed char *)(v) + (CELL-TAG_VECTOR)+((intptr_t)(n))))

#endif /* MEMORY_TRACE */

/*
 * The next are for 16-bit & 32 bit values and single-float & double-float 
 * access. Note that halfwords are signed.
 */
/*
 * On the DEC Alpha the C compiler did not provide a 16-bit data type.
 * In some sense the ARM does not really have one. I am expecting that
 * 16-bit values will only be used in a very few places in my code so
 * performance will not be vital here, so I implement 16-bit access as
 * pairs of 8-bit transfers.
 * NOTE NOTE NOTE that by doing this I am imposing my own idea of
 * byte ordering on 16-bit values in memory. But if the two macros
 * hare are the only use I make I will be safe unless a preserve/restart
 * operation flips things around for me!
 */
#define helt(v, n) \
   ((*(unsigned char *)((v) + (CELL-TAG_VECTOR) + (2*(intptr_t)(n))) | \
    (*(signed char *)((v) + (CELL-TAG_VECTOR+1) + (2*(intptr_t)(n)))) << 8))
#define sethelt(v, n, x) \
   do { \
      *(char *)((v) + (CELL-TAG_VECTOR+0) + (2*(intptr_t)(n))) = (x); \
      *(char *)((v) + (CELL-TAG_VECTOR+1) + (2*(intptr_t)(n))) = (x)>>8; \
      } while (0)
#define ielt(v, n)  (*(intptr_t *)((char *)(v) + \
                           (CELL-TAG_VECTOR)+(((intptr_t)(n))<<ADDRESS_SHIFT)))
/*
 * Even on a 64-bit machine I will support packed arrays of 32-bit
 * ints or short-floats.
 */
#define ielt32(v, n)  (*(int32_t *)((char *)(v) + \
                           (CELL-TAG_VECTOR)+(((intptr_t)(n))<<2)))
#define felt(v, n)  (*(float *)((char *)(v) + \
                           (CELL-TAG_VECTOR)+(((intptr_t)(n))<<2)))
/* NB doubles are 64-bits on every machine */
#define delt(v, n)  (*(double *)((char *)(v) + \
                           (2*CELL-TAG_VECTOR)+(((intptr_t)(n))<<3)))

#ifdef COMMON
/*
 * Simple bit-vectors need extra information held here so that their exact
 * can be determined.  Generally headers hold length information measured
 * in bytes, so three more bits are required here. Bitvectors are not
 * supported in Standard Lisp mode.
 */

#define TYPE_BITVEC1        0x030   /* subtypes encode length mod 8    */
#define TYPE_BITVEC2        0x0b0   /* (counts bits used in last byte) */
#define TYPE_BITVEC3        0x130
#define TYPE_BITVEC4        0x1b0   /* Observe that bit-length continues .. */
#define TYPE_BITVEC5        0x230   /* .. byte-length field in header word. */
#define TYPE_BITVEC6        0x2b0   /* However to extract length of bitvec  */
#define TYPE_BITVEC7        0x330   /* is harder because count here is 1-8  */
#define TYPE_BITVEC8        0x3b0   /* rather than 0-7.                     */

#define header_of_bitvector(h) (((h) & 0x70) == TYPE_BITVEC1)
#endif /* COMMON */

#define TYPE_STRING         0x070   /* simple character vector */
#define TYPE_BPS            0x170   /* bytes of compiled code  */
#define TYPE_SPARE          0x270   /* SPARE (holds binary information) */
#define TYPE_MAPLEREF       TYPE_SPARE /* An EXPERIMENTAL adjustment */
#define TYPE_SP             0x370   /* Encapsulated stack ptr  */

#ifdef COMMON
#define vector_holds_binary(h) (((h) & 0x80) == 0 || header_of_bitvector(h))
#else
#define vector_holds_binary(h) (((h) & 0x80) == 0)
#endif

#define TYPE_SIMPLE_VEC     0x0f0   /* simple general vector */
#define TYPE_HASH           0x1f0   /* hash table */
#define TYPE_ARRAY          0x2f0   /* header record for general array */
#define TYPE_STRUCTURE      0x3f0   /* includes packages etc possibly. */

/*
 * The following classes of vectors will start of as experiments. I want
 * to have at least some vectors that contain a mixture of general and binary
 * information, so TYPE_MIXED1 to TYPE_MIXED4 will serve for this, and are
 * limited to hold exactly three pointer objects. Note that for the garbage
 * collector to work properly I MUST have an odd number of pointers stored
 * in any vector...  "MIXED4" is used for stream handles.
 */

#define is_mixed_header(h) (((h) & 0x2b0) == TYPE_MIXED1)

#define TYPE_VEC8           TYPE_BPS/* contains 8-bit integers */

#define TYPE_VEC16          0x220   /* contains 16-bit integers */
#define TYPE_VEC32          0x260   /* contains 32-bit integers */
#define TYPE_MIXED1         0x2a0   /* general, but limited to 3 pointers */
#define TYPE_MIXED2         0x2e0   /* general, but limited to 3 pointers */
#define TYPE_FLOAT32        0x320   /* contains single-precision floats */
#define TYPE_FLOAT64        0x360   /* contains double-precision floats */
#define TYPE_MIXED3         0x3a0   /* only 3 pointers */
#define TYPE_STREAM         0x3e0   /* 3 pointers then binary data */

#define ODDS_MASK           0xff
#define TAG_CHAR            0x02    /* these cases leave 24 bits spare */
#define TAG_BPS             0x42
/* #define TAG_LITVEC       0x82    .. Not used at present, intended for  */
/*                                  .. read-only vectors in BPS heap.     */
#define TAG_SPID            0xc2    /* Collection of internal flag values */

#define SPID_NIL            (TAG_SPID+0x0000)  /* NIL in checkpoint file  */
#define SPID_FBIND          (TAG_SPID+0x0100)  /* Fluid binding on stack  */
#define SPID_CATCH          (TAG_SPID+0x0200)  /* CATCH frame on stack    */
#define SPID_PROTECT        (TAG_SPID+0x0300)  /* UNWIND_PROTECT on stack */
#define SPID_HASH0          (TAG_SPID+0x0400)  /* Empty hash slot         */
#define SPID_HASH1          (TAG_SPID+0x0500)  /* Deleted hash slot       */
#define SPID_GCMARK         (TAG_SPID+0x0600)  /* Used by GC as sentinel  */
#define SPID_NOINPUT        (TAG_SPID+0x0700)  /* Used by (read) in #X()  */
#define SPID_ERROR          (TAG_SPID+0x0800)  /* Used to indicate error  */
#define SPID_PVBIND         (TAG_SPID+0x0900)  /* PROGV binding on stack  */
#define SPID_NOARG          (TAG_SPID+0x0a00)  /* Missing &OPTIONAL arg   */
#define SPID_NOPROP         (TAG_SPID+0x0b00)  /* fastget entry is empty  */
#define SPID_LIBRARY        (TAG_SPID+0x0c00)  /* + 0xnnn00000 offset     */

#define is_header(x) (((int)(x) & 0x30) != 0)     /* valid if is_odds() */
#define is_char(x)   (((int)(x) & ODDS_MASK) == TAG_CHAR)
#define is_bps(x)    (((int)(x) & ODDS_MASK) == TAG_BPS)
#define is_hashtab(x)(((int)(x) & ODDS_MASK) == TAG_HASHTAB)
#define is_spid(x)   (((int)(x) & ODDS_MASK) == TAG_SPID)
#define is_library(x)(((int)(x) & 0xffff)    == SPID_LIBRARY)
#define library_number(x) (((x) >> 20) & 0xfff)

/*
 * For no especially good reason I represent an end of file marker
 * as character 4 (^D) in font number 255.  That at least keeps it
 * away from the standard characters that exist in font 0.
 * If "Kanji" is defined then Forbs Systems Co code to support
 * Eastern alphabets is enabled. Note that the original arrangement
 * of FONT/BITS/CODE that I had was as mandated for Common Lisp and that
 * the Kanji option is thus probably not directly compatible with
 * Common Lisp mode. To make life a little closer to reasonable in this
 * regard I will support both names needed for Common and Kanji.
 * Thus a character is stored using 24 bits (plus 8 bits of tag):
 *       Kanji mode           Ordinary mode
 *       font                 font
 *       code )               bits
 *       code ) 16 bits       code
 * Note that pack_char could now take a 16-bit code which would then fill in
 * all of code.  Note also that to avoid pain with re-working historical
 * bits of the CSL code I leave the macro pack_char with args in the order
 * bits/font/code.  In Common Lisp Mode if Kanji is enabled then extended
 * characters will have "bits".
 */
#define font_of_char(n)  (((int32_t)(n) >> 24) & 0xff)
#define bits_of_char(n)  (((int32_t)(n) >> 16) & 0xff)
#ifdef Kanji
#define code_of_char(n)  (((int32_t)(n) >>  8) & 0xffff)
#else
/* NB cast to (char) in case that is a signed type. Ugh! */
#define code_of_char(n)  ((char)(((int32_t)(n) >>  8) & 0xff))
#endif

#define pack_char(bits, font, code)                                \
    ((Lisp_Object)((((uint32_t)(font)) << 24) |                  \
    (((uint32_t)(bits)) << 16) | (((uint32_t)(code)) << 8) | TAG_CHAR))
    
#define CHAR_EOF pack_char(0, 0xff, 4)
 

/*
 * The following shows that a BPS entrypoint is represented with
 * 8 bits of tag at the bottom of the word.  There follow (PAGE_BITS-2)
 * bits of word-offset within the page.  Finally the rest of the word is
 * a page number.  This allows for up to 64 Mbytes of code space if I
 * am on a 32-bit machine. If PAGE_BITS is 22 (my current default on
 * most systems) this will be up to 16 pages each holding 4 Mbytes.
 * Given the compactness of the bytecode format the limit seems generous
 * enough at present!
 */
#define data_of_bps(v) \
  ((char *)(doubleword_align_up((intptr_t) \
             bps_pages[((uint32_t)(v))>>(PAGE_BITS+6)]) + \
            (((v) >> 6) & (PAGE_POWER_OF_TWO-4))))


typedef int32_t junk;      /* Unused 4-byte field for structures (for padding) */
typedef intptr_t junkxx;    /* Unused cell-sized field for structures */

typedef struct Symbol_Head
{
    Header header;      /* Standard format header for vector types */
/*
 * TAG_SYMBOL has the value 4, so on a 32-bit system a pointer
 * to a symbol points at the second word of it, ie the value cell. The
 * effect in that case is that the selector CAR would access the value
 * cell. For 64-bit addresses this pun will not work so easily. The
 * main case where this causes BIG pain is in Common Lisp mode wrt NIL
 * where (car nil) and (cdr nil) must both be legal and yield nil. This
 * can be handled by tagging NIL as a CONS not a SYMBOL in the Common Lisp
 * case. But then when NIL is used as a SYMBOL all the offsets will be
 * wrong... In 32-bit mode this makes 
 *
 * BEWARE!
 */
    Lisp_Object value;  /* Global or special value cell */
    Lisp_Object env;    /* Extra stuff to help function cell */
    intptr_t function1;     /* Executable code always (just 1 arg) */
    intptr_t function2;     /* Executable code always (just 2 args) */
    intptr_t functionn;     /* Executable code always (0, or >= 3 args) */
    Lisp_Object pname;   /* A string (always) */
    Lisp_Object plist;   /* A list */
    Lisp_Object fastgets;/* to speed up flagp and get */
    uintptr_t count;     /* for statistics */
#ifdef COMMON
    Lisp_Object package;/* Home package - a package object */
/*
 * If I am on a 32-bit system in COMMON mode then all objects are padded
 * to be an even number of cells long, so I need a padding word here. I
 * view it as holding binary data and so will never even bother the
 * initialise it.
 */
/*
 * But because C does not let me use "sizeof" in an #ifdef I can not put
 * this here the way I would perhaps like to!
 *
 * #if !SIXTY_FOUR_BIT
 *     intptr_t padding;
 * #endif
 */
#endif /* COMMON */
} Symbol_Head;


#define MAX_FASTGET_SIZE  63
/* I have up to 63 "fast" tags for PUT/GET/FLAG/FLAGP */

/*
 * The next bit is just to cope with the funny status of NIL in Common Lisp
 * on 64-bit architures, where the tagging pretty well breaks down.
 */
#ifdef COMMON
#define symalign(n) (SIXTY_FOUR_BIT ? \
     ((char *)((intptr_t)(n) & ~(intptr_t)TAG_SYMBOL)) : \
     (n)
#else
#define symalign(n) (n)
#endif

#ifndef MEMORY_TRACE

/*
 * The access macros are coded this way rather than using -> and
 * a structure since this reveals directly what offsets are involved
 * in the addressing, and so gives the C compiler an easier job!
 * There are so many casts anyway that this is not so very bad really!
 * I also use absolute numeric offsets (and do not use the offsetof
 * macro) to stress that I view the store layout as fixed, and because
 * offsetof is badly supported by some C compilers I have come across.
 */
#define qheader(p)     (*(Header *)     symalign((char *)(p) - TAG_SYMBOL))
#define qvalue(p)      (*(Lisp_Object *)symalign((char *)(p) + (CELL - TAG_SYMBOL)))
#define qenv(p)        (*(Lisp_Object *)symalign((char *)(p) + (2*CELL - TAG_SYMBOL)))

#define qfn1(p)        ((one_args *) *((intptr_t *)symalign((char *)(p) + \
                                         (3*CELL - TAG_SYMBOL))))
#define qfn2(p)        ((two_args *) *((intptr_t *)symalign((char *)(p) + \
                                         (4*CELL - TAG_SYMBOL))))
#define qfnn(p)        ((n_args *)   *((intptr_t *)symalign((char *)(p) + \
                                         (5*CELL - TAG_SYMBOL))))
/*
 * The ifn() selector gives access to the qfn() cell, but treating its
 * contents as (intptr_t).
 */
#define ifn1(p)        (*(intptr_t *)      symalign((char *)(p) + (3*CELL-TAG_SYMBOL)))
#define ifn2(p)        (*(intptr_t *)      symalign((char *)(p) + (4*CELL-TAG_SYMBOL)))
#define ifnn(p)        (*(intptr_t *)      symalign((char *)(p) + (5*CELL-TAG_SYMBOL)))

#define qpname(p)      (*(Lisp_Object *)symalign((char *)(p) + (6*CELL-TAG_SYMBOL)))
#define qplist(p)      (*(Lisp_Object *)symalign((char *)(p) + (7*CELL-TAG_SYMBOL)))

#define qfastgets(p)   (*(Lisp_Object *)symalign((char *)(p) + (8*CELL-TAG_SYMBOL)))
#define qcount(p)      (*(uintptr_t *) symalign((char *)(p) + (9*CELL-TAG_SYMBOL)))

#ifdef COMMON
#define qpackage(p)    (*(Lisp_Object *)symalign((char *)(p) + (10*CELL-TAG_SYMBOL)))
#endif

#else /* MEMORY_TRACE */

#define qheader(p)     (*(Header *)     memory_reference((intptr_t) \
                                         symalign((char *)(p) - TAG_SYMBOL)))
#define qvalue(p)      (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (CELL-TAG_SYMBOL))))
#define qenv(p)        (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (2*CELL-TAG_SYMBOL))))
#define qfn1(p)        ((one_args *) *(intptr_t *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (3*CELL-TAG_SYMBOL))))
#define qfn2(p)        ((two_args *) *(intptr_t *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (4*CELL-TAG_SYMBOL))))
#define qfnn(p)        ((n_args *)   *(intptr_t *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (5*CELL-TAG_SYMBOL))))
#define ifn1(p)        (*(intptr_t *)      memory_reference((intptr_t) \
                                         symalign((char *)(p) + (3*CELL-TAG_SYMBOL))))
#define ifn2(p)        (*(intptr_t *)      memory_reference((intptr_t) \
                                         symalign((char *)(p) + (4*CELL-TAG_SYMBOL))))
#define ifnn(p)        (*(intptr_t *)      memory_reference((intptr_t) \
                                         symalign((char *)(p) + (5*CELL-TAG_SYMBOL))))
#define qpname(p)      (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (6*CELL-TAG_SYMBOL))))
#define qplist(p)      (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (7*CELL-TAG_SYMBOL))))
#define qfastgets(p)   (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (8*CELL-TAG_SYMBOL))))
#define qcount(p)      (*(uintptr_t *) memory_reference((intptr_t) \
                                         symalign((char *)(p) + (9*CELL-TAG_SYMBOL))))
#ifdef COMMON
#define qpackage(p)    (*(Lisp_Object *)memory_reference((intptr_t) \
                                         symalign((char *)(p) + (10*CELL-TAG_SYMBOL))))
#endif

#endif /* MEMORY_TRACE */

#ifdef COMMON
typedef union Float_union
{
    float f;
    int32_t i;
} Float_union;
#endif

typedef struct Big_Number
{
/* see "arith.h" for a description of bignum formats */
    Header h;
/*
 * EVEN when I have 64-bit addresses I will represent
 * big-numbers as arrays of 32-bit values.  So I will still have to
 * ensure that I end up with a rounded number of digits - but in the
 * 64-bit case it will need to be an even number because the
 * header word at the front of a bignum becomes 64-bits long.
 */
    uint32_t d[1];  /* generally more digits than this */
} Big_Number;

#define bignum_length(b)  length_of_header(numhdr(b))
#ifdef MEMORY_TRACE
#define bignum_digits(b)  ((uint32_t *)memory_reference((intptr_t)((char *)b + \
                                         (CELL-TAG_NUMBERS))))
#else
#define bignum_digits(b)  ((uint32_t *)((char *)b  + (CELL-TAG_NUMBERS)))
#endif
#define make_bighdr(n)    (TAG_ODDS+TYPE_BIGNUM+(((intptr_t)(n))<<12))
#define pack_hdrlength(n) (((intptr_t)(n))<<12)

#ifdef COMMON
typedef struct Rational_Number
{
    Header header;
    Lisp_Object num;
    Lisp_Object den;
} Rational_Number;

#define numerator(r)    (((Rational_Number *)((char *)(r)-TAG_NUMBERS))->num)
#define denominator(r)  (((Rational_Number *)((char *)(r)-TAG_NUMBERS))->den)

typedef struct Complex_Number
{
    Header header;
    Lisp_Object real;
    Lisp_Object imag;
} Complex_Number;

#define real_part(r)    (((Complex_Number *)((char *)(r)-TAG_NUMBERS))->real)
#define imag_part(r)    (((Complex_Number *)((char *)(r)-TAG_NUMBERS))->imag)

typedef struct Single_Float
{
    Header header;
    union float_or_int {
       float f;
       int32_t i;
    } f;
} Single_Float;

#define single_float_val(v) \
    (((Single_Float *)((char *)(v)-TAG_BOXFLOAT))->f.f)

#endif /* COMMON */

/*
 * The structures here are not actually used - because I can not get
 * as strong control of alignment as I would like. So I use macros that
 * do address arithmetic explicitly for me...
 *
 *  typedef struct Double_Float
 *  {
 *      Header header;
 *                            // SIXTY_FOUR_BIT is not a compile-time constant
 *  #ifndef SIXTY_FOUR_BIT    // Can not do this #ifdef!!
 *      junk padding;         // for 64-bit the header was 64 bits wide
 *  #endif
 *      union double_or_ints {
 *          double f;         // padded to doubleword align the data.
 *          int32_t i[2];
 *      } f;
 *  } Double_Float;
 */

#define SIZEOF_DOUBLE_FLOAT     16
#define double_float_addr(v)    ((double *)((char *)(v) + \
                                   (8-TAG_BOXFLOAT)))
#define double_float_val(v)     (*(double *)((char *)(v) + \
                                   (8-TAG_BOXFLOAT)))

#ifdef COMMON

/*
 * Again I do not actually introduce the struct...
 *
 *  typedef struct Long_Float
 *  {
 *                          // For use if I ever wanted an 80-bit float type.
 *      Header header;
 *  #ifndef SIXTY_FOUR_BIT  // Illegal #ifdef here!
 *      junk padding;
 *  #endif
 *      union long_or_ints {
 *          double f;
 *          int32_t i[2];
 *      } f;
 *  } Long_Float;
 */

#define SIZEOF_LONG_FLOAT       16
#define long_float_addr(v)      ((double *)((char *)(v) + \
                                   (8-TAG_BOXFLOAT)))
#define long_float_val(v)       (*(double *)((char *)(v) + \
                                   (8-TAG_BOXFLOAT)))
#endif

#define doubleword_align_up(n) ((Lisp_Object)(((intptr_t)(n) + 7) & (-8)))
#define doubleword_align_down(n) ((Lisp_Object)((intptr_t)(n) & (-8)))

/*
 * For the benefit of 64-bit architectures I will make the big blocks
 * of memory that I allocate from 128-bit aligned. This may help me at
 * one delicate place in the garbage collector!
 */
#define quadword_align_up(n) ((Lisp_Object)(((intptr_t)(n) + 15) & (-16)))
#define quadword_align_down(n) ((Lisp_Object)((intptr_t)(n) & (-16)))

/*
 * values to go in exit_reason at times when exception_pending() is true.
 */

#define UNWIND_NULL       0x0         /* no error or action at all */
#define UNWIND_GO         0x1
#define UNWIND_RETURN     0x2
#define UNWIND_THROW      0x3
#define UNWIND_RESTART    0x4

#define UNWIND_ERROR      0x100       /* when backtrace is needed */
#define UNWIND_UNWIND     0x200       /* no backtrace, still an error */

#endif /* header_tags_h */

/* end of tags.h */

