/*------------------------->  ANSI C - headerfile  <-------------------------*/
/* Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        */
/* This file is part of the GNU Sather library. It is free software; you may */
/* redistribute  and/or modify it under the terms of the GNU Library General */
/* Public  License (LGPL)  as published  by the  Free  Software  Foundation; */
/* either version 2 of the license, or (at your option) any later version.   */
/* This  library  is distributed  in the  hope that it will  be  useful, but */
/* WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY */
/* or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       */
/* The license text is also available from:  Free Software Foundation, Inc., */
/* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     */
/*------------>  Please email comments to <bug-sather@gnu.org>  <------------*/

/* - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

          This file contains references to all of the routines and macros
     relied upon by either compiler-generated code or special run-time engine
     actions which are independent of the operating system.

          Version 2.0 Oct 98.  Copyright K Hopper, U of Waikato

                          Development History
                          -------------------

        Date           Who By         Detail
        ----           ------         ------

        15 Oct 98        kh       Original from Sather 1.2 distribution.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/* (JN) for 32 bit character strings */
char *create_c_string(STR str) ;


/* #include "interface.h" */

          /* Routines which are provided in runtime.c */

void rt_aset(void *buf, INT bit, BOOL val, INT maxbits) ;
BOOL rt_aget(void *buf, INT bit, INT maxbits) ;
FLT rt_flt_aset(FLT f,INT bit,BOOL val) ;
BOOL rt_flt_aget(FLT f, INT bit) ;
FLTD rt_fltd_aset(FLTD f, INT bit, BOOL val) ;
BOOL rt_fltd_aget(FLTD f, INT bit) ;
void rt_flt_get_rep(FLT f,BOOL* sign,INT* exp,INT* mantissa) ;
void rt_fltd_get_rep(FLTD f,BOOL* sign,INT* exp,INT* mlo,INT* mhi) ;

void *rt_arr_alloc(size_t size1, INT tag, size_t size2, INT n) ;


char **rt_create_astr (int size, char *s) ;


#ifdef DEBUG
     #define S_DEBUG
#endif

#ifdef STATS
     #ifndef RUNTIME
extern int rt_dispatches ;
     #endif

     #define COUNT_DISPATCH rt_dispatches++
#endif

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

          Argument replication in macros may be made.   However, this relies
     upon the compiler always making temporary locals for anything that might
     be a macro.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

#ifdef PRINT_BACKTRACE
     #ifdef DEBUG
extern int rt_fatal_po(char *,int,char *,struct _func_frame *) ;
extern int rt_fatal_p2_o(char *,int,char *,char *,struct _func_frame *) ;

          #define FATAL(msg)      rt_fatal_po(__FILE__,__LINE__,msg,&FF)
          #define FATAL2(msg,str) rt_fatal_2_po(__FILE__,__LINE__,msg,str,&FF)
     #else
extern int rt_fatal_po(char *,struct _func_frame *) ;
extern int rt_fatal_p2_o(char *,char *,struct _func_frame *) ;

          #define FATAL(msg)      rt_fatal_po(msg,&FF)
          #define FATAL2(msg,str) rt_fatal_2_po(msg,str,&FF)
     #endif
#else
     #ifdef DEBUG
          #define FATAL(msg)      rt_fatal(__FILE__,__LINE__,msg)
          #define FATAL2(msg,str) rt_fatal_2(__FILE__,__LINE__,msg,str)
     #else
          #define FATAL(msg)      rt_fatal2(msg)
          #define FATAL2(msg,str) rt_fatal2_2(msg,str)
     #endif
#endif

#define SAMIN(x,y)       (((x)<(y))?(x):(y))

#define CHKERR(x,msg,y) (((x)?FATAL(msg):0),(y))
#define CHKOK(x,msg,y)      (((!(x))?FATAL(msg):0),(y))

#define DESTROYED(x)   ((OB)x)->header.destroyed
#define DESTROY(x)     ((OB)x)->header.destroyed=1
#define VOID(x)        (x)==NULL

#ifdef BOUNDS_CHK
     #define CHK_BOUNDS(v,low,high,expr) \
                    CHKERR(((v)<(low)||(v)>(high)),"Out of bounds",expr)
#else
     #define CHK_BOUNDS(v,low,high,expr) (expr)
#endif

#ifdef DESTROY_CHK
     #if defined(VOID_CHK) && !defined(NULL_SEGFAULTS)
          #define CHK(x,y) \
              CHKERR(VOID(x),"Access to void",CHKERR(DESTROYED(x), \
                                        "Access to destroyed object",(y)))
     #else
          #define CHK(x,y) CHKERR(DESTROYED(x),"Access to destroyed object",(y))
     #endif
#else
     #if defined(VOID_CHK) && !defined(NULL_SEGFAULTS)
          #define CHK(x,y) CHKERR(VOID(x),"Access to void",(y))
     #else
          #define CHK(x,y) y
     #endif
#endif

/****************************************************************************
**
**  JN:  New stuff added for new types.
**
	Last change:  KH   13 Jan 2000    2:32 pm
****************************************************************************/

/********* BIT builtins' *********/

#define CARDBIT(x) \
           CHKOK(x==0||x==1,"CARD would overflow conversion to BIT", (BIT)x)

/********* BOOL builtins' are found in the bool.config file *********/

/********* OCTET builtins' *********/

#define OCTHEXTET(x) (HEXTET)x

#define OCTET_MAXOCTET       255    /* JN: maximum representable for an OCTET*/

#define CARDOCTET(x) \
            CHKOK(x <= OCTET_MAXOCTET, \
                "CARD would overflow conversion to OCTET", (unsigned char)x)
#define OCTETSHIFT(x,s)           (s<0)?(x>>(-(s))):(x<<s)


/********* HEXTET builtins' *********/

#define HEXOCTET(x) (OCTET)x

#define HEXTET_MAXHEXTET     65535     /* JN:  max representable for HEXTET */

#define CARDHEXTET(x) \
               CHKOK(x <= HEXTET_MAXHEXTET, \
                 "CARD would overflow conversion to HEXTET", (unsigned short)x)
#define HEXTETSHIFT(x,s)          (s<0)?(x>>(-(s))):(x<<s)
/********* QUAD builtins' *********/

#define QUADSHIFT(x,s)            (s<0)?(x>>(-(s))):(x<<s)


/********* CARD builtins' *********/

#define CARDINT(x) \
                   CHKOK(((CARD)((INT)x)) == x, \
                        "Cardinal would overflow conversion to INT",(INT)x)
#define CARDFLT(x) \
                   CHKOK(((CARD)((FLT)x)) == x, \
                        "Cardinal would overflow conversion to FLT",(FLT)x)
#define CARDFLTD(x) \
                    CHKOK(((CARD)((FLTD)x)) == x, \
                       "Cardinal would overflow conversion to FLTD",(FLTD)x)
#define CARDPLUS(x,y) \
                     CHKOK(x <= (SCARD_MAX - y),"Cardinal overflow on plus", \
                                                 ((unsigned)x) + ((unsigned)y))
#define CARDMINUS(x,y) \
                     CHKOK(y <= x,"Cardinal overflow on minus", \
                                                  ((unsigned)x) - ((unsigned)y))
#define CARDTIMES(x,y) \
                     CHKOK((x == 0) || (y <= SCARD_MAX / x), \
                      "Cardinal overflow on times",((unsigned)x)*((unsigned)y))
#define CARDDIV(x,y) \
                       CHKOK(y != 0,"Cardinal division by zero", \
                                                   ((unsigned)x)/((unsigned)y))
#define CARDMOD(x,y) \
              CHKOK(y != 0,"Cardinal mod by zero",((unsigned)x)%((unsigned)y))


/********* FIELD builtins' *********/

#define FIELDPLUS(x,y)            x+y
#define FIELDMINUS(x,y)           x-y
#define FIELDTIMES(x,y)           x*y
#define FIELDDIV(x,y)             (x<0&&x!=(x/y)*y)?(x/y)-1:(x/y)
#define FIELDMOD(x,y)             ((x%y)<0)?(x%y)+y:(x%y)


/********* INT builtins' *********/

#ifndef ARITH_CHK
     #define INTCHAR(x)               (char)x
     #define INTCARD(x)               (CARD)x
     #define INTFLT(x)                (FLT)x
     #define INTFLTD(x)               (FLTD)x
     #define INTPLUS(x,y)             x + y
     #define INTMINUS(x,y)            x - y
     #define INTTIMES(x,y)            x * y
     #define INTDIV(x,y)     (x < 0 && x != (x / y) * y) ? (x / y) - 1 :(x / y)
     #define INTMOD(x,y)     ((x % y) < 0) ? (x % y) + y : (x % y)
#else
     #define INTCHAR(x) \
                  CHKOK(((INT)((char)x)) == x, \
                        "Integer would overflow conversion to CHAR",(char)x)
     #define INTCARD(x) \
                CHKOK(x >= 0,"Trying to convert a negative integer to CARD", \
                                                                     (CARD)x)
     #define INTFLT(x) \
                CHKOK(((INT)((FLT)x)) == x, \
                             "Integer would overflow conversion to FLT",(FLT)x)
     #define INTFLTD(x) \
                  CHKOK(((INT)((FLTD)x)) == x, \
                         "Integer would overflow conversion to FLTD",(FLTD)x)
     #define INTPLUS(x,y) \
                   CHKOK(((y >= 0 && x <= (SINT_MAX - y)) || (y < 0 && x >= \
                                    ((signed)(((unsigned)SINT_MIN) - y)))), \
                                          "Integer overflow on plus",x + y)
     #define INTMINUS(x,y) \
                    CHKOK(((y >= 0 && x >= (SINT_MIN + y)) || (y < 0 && x <= \
                                   ((signed)(((unsigned)SINT_MAX) + y)))), \
                                          "Integer overflow on minus",x - y)
     #define INTTIMES(x,y) \
                    CHKOK(((x == 0) || (y == 0) || (x > 0 && y >0 && y <= \
                         SINT_MAX / x) || (x > 0 && y < 0 && y >= \
                              SINT_MIN / x) || (x < 0 && y > 0 && x >= \
                              SINT_MIN / y) || (x < 0 && y < 0 && x != \
                              SINT_MIN && y != SINT_MIN && - x <= \
                              SINT_MAX / (- y))), \
                                        "Integer overflow on times",x * y)
     #define INTDIV(x,y) \
                        CHKOK(y != 0,"Division by zero", \
                        ((x < 0 && x != (x / y) * y) ? (x / y) - 1 : (x / y)))
     #define INTMOD(x,y) \
                        CHKOK(y != 0,"Mod by zero", \
                                        ((x % y) < 0) ? (x % y) + y : (x % y))
#endif

#define INTNEGPOSSIBLE(x)        (x!=SINT_MIN)?1:0
#define INTRSHIFT(x,s)           (x<0)?x>>s:(~((~x)>>s))

/*     To defeat the minint problem on some CPUs */

#define INTISLT(x,y)    (((x)==SINT_MIN)?((x)!=(y)):((x)<(y)))
#define INTABS(x)       (((x)==SINT_MIN)?\
                              (FATAL("integer overflow")):\
                              (((x)<0)?(-x):(x)))

/********* FLOAT builtins' *********/

#define FLTCARD(x)        CHKERR(x < 0 || ((CARD)x) != x, \
                                                    "Not a cardinal", (CARD)x)

#ifndef ARITH_CHK
     #define FLTINT(x)                (INT)x
     #define FLTFIELD(x)              (FIELD)x
#else
     #define FLTINT(x) \
                         CHKERR(((INT)x) != x,"Not an integer", (INT)x)
     #define FLTFIELD(x) \
                         CHKERR(((FIELD)x) != x,"Not integer", (FIELD)x)
#endif

#if !defined (FLT_MAX) || !defined (MINFLOAT)
     #define FLTMINNORMAL             r_min_normal()
     #define FLTMAXNORMAL             r_max_normal()
     #define FLTMINSUBNORMAL          r_max_subnormal()
     #define FLTMAXSUBNORMAL          r_min_subnormal()

          /* FLTD stuff for convenience */

     #define FLTDMINNORMAL            min_normal()
     #define FLTDMAXNORMAL            max_normal()
     #define FLTDMINSUBNORMAL         min_subnormal()
     #define FLTDMAXSUBNORMAL         max_subnormal()
#else
     #define FLTMINNORMAL             FLT_MIN
     #define FLTMAXNORMAL             FLT_MAX
     #define FLTMINSUBNORMAL          MINFLOAT    /* is this right? */
     #define FLTMAXSUBNORMAL          MAXFLOAT

          /* FLTD stuff for convenience */

     #define FLTDMINNORMAL            DBL_MIN  /* FLTD stuff for convenience */
     #define FLTDMAXNORMAL            DBL_MAX
     #define FLTDMINSUBNORMAL         MINDOUBLE   /* is this right? */
     #define FLTDMAXSUBNORMAL         MAXDOUBLE
#endif

          /* Note that IEEE 754 states not to check for divide by zero! */

#define FLTDIV(x,y)              x/y

#if defined (SUNOS4)
     #define FLTDTRUNCATE(x)        aint(x)
     #define FLT_TRUNCATE(x)        ((FLT)aint((FLTD)x))
#elsif defined (_AIX) || defined (__sgi)
     #define FLTDTRUNCATE(x)        trunc(x)
     #define FLTTRUNCATE(x)         ((FLT)trunc((FLTD)x))
#else
     #define FLTDTRUNCATE(x)        (((x) < 0.0) ? ceil(x) : floor(x))
     #define FLTTRUNCATE(x)         (FLT)FLTDTRUNCATE((FLTD)x)
#endif

#if defined (__hpux) || defined (SCO) || defined (__riscos__)
     #define FLTDROUND(x) \
                      (fabs(x - floor(x)) < 0.5) ? floor(x) : (floor(x) + 1)
#else
     #define FLTDROUND(x)          rint(x)
#endif

#define FLTROUND(x)             (FLT)FLTDROUND((FLTD)x)

#define FLTSTORE(x,s) \
                  (sprintf((s)->arr_part,"%g",x),strlen((s)->arr_part))
#define FLTSTOREPREC(x,p,s) \
                  (sprintf((s)->arr_part,"%.*g",p,x),strlen((s)->arr_part))


/********* FLTD builtins' *********/

#define FLTDCARD(x)    CHKERR(x < 0 || ((CARD)x) != x,"Not a cardinal",(CARD)x)

#define FLTDDIV(x,y)   (x / y)

#ifndef ARITH_CHK
     #define FLTDINT(x)             (INT)x
     #define FLTDFIELD(x)           (FIELD)x
#else
     #define FLTDINT(x)          CHKERR(((INT)x) != x,"Not an integer",(INT)x)
     #define FLTDFIELD(x)        CHKERR(((FIELD)x) != x,"Not integer",(FIELD)x)
#endif

#ifdef linux
     #define FLTDEXP10(x)           pow10(x)
     #define iszero(f)              ((f) == 0.0)
/* static int ilogb(double x)    { int i ; frexp(x,&i) ; return i-1 ; } */
     #define isnormal(x)            ((int)1)  /* these two are hacks esc */
     #define issubnormal(x)         ((int)0)
#elif defined(_AIX) || defined(SUNOS5) || defined(__NeXT__) || \
                   defined(__sgi) || defined(ALPHA) || defined(__hpux) || \
                    defined(__FreeBSD__) || defined(__alpha) || defined (WIN32)
     #define FLTDEXP10(x)           pow((double)10.0,x)
#else
     #define FLTDEXP10(x)           exp10(x)
#endif

#define FLTDSTORE(f,s) \
                    (sprintf((s)->arr_part,"%g",f),strlen((s)->arr_part))
#define FLTDSTOREPREC(f,p,s) \
                    (sprintf((s)->arr_part,"%.*lg",p,f),strlen((s)->arr_part))

#define FLTASET(f,b,v)  CHK_BOUNDS(b,0,31,rt_fltaset(f,b,v))
#define FLTAGET(f,b)    CHK_BOUNDS(b,0,31,rt_fltaget(f,b))
#define FLTDASET(f,b,v) CHK_BOUNDS(b,0,63,rt_fltdaset(f,b,v))
#define FLTDAGET(f,b)   CHK_BOUNDS(b,0,63,rt_fltdaget(f,b))


/*
** 4.1 AIX native C compiler does not allow to return qualified const types.
** Oddly enough, 3.2 AIX compiler does not mind.  This is also true for ULTRIX
*/

#if (defined(_AIX41) || defined(ultrix)) && !defined(__GNUC__) || \
                                                          defined(__alpha)
     #define RETURNED_CONST
#else
     #define RETURNED_CONST const
#endif

/* This is from stoehr@informatik.tu-muenchen.de */
#if defined(__hpux) || defined(linux) || defined(__NEXT__)
     #define cbrt(v)       pow(v,(1.0/3.0))
double scalbn(double, int) ;
#endif

#if defined(SUNOS5) || defined(__hpux) || defined(__FreeBSD__) || \
        defined(__sgi) || defined(linux) || defined(__alpha) || defined (WIN32)
double signaling_nan(int sig) ;
double infinity() ;
#endif


/********** IN **********/

#define INGETSTRSIZED(s,sz) \
                   CHK_BOUNDS(sz - 1,0,s->loc,fgets((s)->arr_part,sz,stdin))


/********** SYS **********/

/* There are variations between the above and here.
** Are some of the following required */

#ifndef DESTROY_CHK

     #define SYSDESTROY(x)   ZFREE(x)
     #define ATTR(x,y)       (x)->y
     #define ATTRs(x,y,n)    ((x) == NULL ? (n) : ((x)->y))
     #define SATTR(x,y,z)    (x)->y = z
     #define TAG(x)          ((OB)x)->header.tag
     #define STAG(x,y)       ((OB)x)->header.tag = y
     #define ASIZE(x)        (x)->asize
     #define VASIZE(x)       (x ## _asize) /* value types, x must be the type */
     #define ARR(x,y)        CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y])
     #define VARR(T,x,y)     CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y])
     #define SARR(x,y,z)     CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y] = z)
     #define VSARR(T,x,y,z)  CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y] = z)

#else
     #ifdef NULL_SEGFAULTS

          /* if accesses of NULL pointers are guaranteed to segfault, in-line
              code generation to check for this is unnecessary.
           */

          #define SYSDESTROY(x) \
                    CHKERR(DESTROYED(x), \
                        "Tried to destroy already destroyed object",DESTROY(x))
          #define ATTR(x,y) \
                   CHKERR(DESTROYED(x),"Attr access of destroyed object",x->y)
          #define ATTRs(x,y,n) \
                     ((x) == NULL ? (n) : ((x)->y))
          #define SATTR(x,y,z) \
                  CHKERR(DESTROYED(x), \
                          "Attr write access of destroyed object",x->y = z)
          #define TAG(x) \
                         CHKERR(DESTROYED(x), \
                         "Tag access of destroyed object",((OB)x)->header.tag)
          #define STAG(x,y) \
                         CHKERR(DESTROYED(x), \
                         "Tag access of destroyed object",((OB)x)->header.tag = (short)y)
          #define ASIZE(x) \
                         CHKERR(DESTROYED(x), \
                              "Asize access of destroyed object",(x)->asize)
          #define VASIZE(x) \
                        (x ## _asize) /* for value types, x must be type */
          #define ARR(x,y) \
                         CHKERR(DESTROYED(x), \
                              "Array access of destroyed object", \
                              CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y]))
          #define VARR(T,x,y) \
                          CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y])
          #define SARR(x,y,z) \
                          CHKERR(DESTROYED(x), \
                          "Array write access of destroyed object", \
                             CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y] = z))
          #define VSARR(T,x,y,z) \
                          CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y] = z)
     #else
          #ifdef __GNUC__   /* If this is GNU C, use the hash directives */
               #define SYSDESTROY(x)   CHKERR(VOID(x), \
                        "Tried to destroy void", CHKERR(DESTROYED(x), \
                      "Tried to destroy already destroyed object",DESTROY(x)))
               #define ATTR(x,y)       CHKERR(VOID(x), \
                     "Attr access of void " #x "." #y,CHKERR(DESTROYED(x), \
                                 "Attr access of destroyed object",((x)->y)))
               #define ATTRs(x,y,n)    ((x) == NULL ? (n) : ((x)->y))
               #define SATTR(x,y,z)    CHKERR(VOID(x), \
                         "Attr write access of void " #x "." #y "=" #z, \
                              CHKERR(DESTROYED(x), \
                                  "Attr write access of destroyed object", \
                                                                     x->y = z))
               #define TAG(x)   CHKERR(VOID(x),"Tag access of void " #x, \
                      CHKERR(DESTROYED(x),"Tag access of destroyed object", \
                                                          ((OB)x)->header.tag))
               #define ASIZE(x)   CHKERR(VOID(x),"Asize access of void " #x, \
                      CHKERR(DESTROYED(x),"Asize access of destroyed object", \
                                                                    (x)->asize))
               #define VASIZE(x) (x ## _asize) /* for val types, x is type */
               #define ARR(x,y)   CHKERR(VOID(x), \
                      "Array access of void " #x "[" #y "]", \
                      CHKERR(DESTROYED(x),"Array access of destroyed object", \
                               CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y])))
               #define VARR(T,x,y) CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y])
               #define SARR(x,y,z)       CHKERR(VOID(x), \
                         "Array write access of void " #x "[" #y "]=" #z, \
                           CHKERR(DESTROYED(x), \
                           "Array write access of destroyed object", \
                           CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y] = z)))
               #define VSARR(T,x,y,z)  CHK_BOUNDS(y,0,VASIZE(T) - 1, \
                                                     (x).arr_part[y] = z)
          #else   /* If not GNU */
               #define SYSDESTROY(x) \
                       CHKERR(VOID(x),"Tried to destroy void", \
                       CHKERR(DESTROYED(x), \
                        "Tried to destroy already destroyed object",DESTROY(x)))
               #define ATTR(x,y) \
                       CHKERR(VOID(x),"Attr access of void", \
                       CHKERR(DESTROYED(x), \
                               "Attr access of destroyed object",((x)->y)))
               #define ATTRs(x,y,n) ((x) == NULL ? (n) : ((x)->y))
               #define SATTR(x,y,z) \
                       CHKERR(VOID(x),"Attr write access of void", \
                       CHKERR(DESTROYED(x), \
                           "Attr write access of destroyed object",x->y = z))
               #define TAG(x) \
                       CHKERR(VOID(x),"Tag access of void", \
                       CHKERR(DESTROYED(x), \
                        "Tag access of destroyed object", ((OB)x)->header.tag))
               #define ASIZE(x) \
                       CHKERR(VOID(x),"Asize access of void", \
                       CHKERR(DESTROYED(x), \
                             "Asize access of destroyed object",(x)->asize))
               #define VASIZE(x) \
                         (x ## _asize) /* for value types, x must be type */
               #define ARR(x,y) \
                     CHKERR(VOID(x),"Array access of void", \
                     CHKERR(DESTROYED(x),"Array access of destroyed object", \
                           CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y])))
               #define VARR(T,x,y) \
                      CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y])
               #define SARR(x,y,z) \
                      CHKERR(VOID(x),"Array write access of void", \
                      CHKERR(DESTROYED(x), \
                      "Array write access of destroyed object", \
                      CHK_BOUNDS(y,0,ASIZE(x) - 1,(x)->arr_part[y] = z)))
               #define VSARR(T,x,y,z) \
                       CHK_BOUNDS(y,0,VASIZE(T) - 1,(x).arr_part[y] = z)
          #endif
     #endif
#endif

/*
 * define some macros used in pSather, which are also used in Sather
 * (for compatibility reasons)
 */

#ifndef PSATHER
     #define READTAG(t,obj)  ((t) = TAG(obj))
#endif


#ifdef DETERMINISTIC
     #define SYSID(x) \
                     CHK(x,CHKOK(((OB)x)->header.tag >= 0, \
                          "Called SYS::id on value type",((OB)x)->header.id))
#else

/* Chop off bits from right side.  The exect number depends on whether the
 * allocator aligns things strongly.  If this isn't true, then
 * a smaller number of bits (like 2) might be more appropriate.
*/

     #define SYSID(x) \
                   CHK(x,CHKOK(((OB)x)->header.tag >= 0, \
                           "Called SYS::id on value type", \
                             (INT)(((unsigned long)x) >> 3)))
#endif

#define SYSTP(x)        TAG(x)
#define SYSSTRFORTP(x)  gen_SYS_str_for_tp(x)
#define SYSOBEQ(x,y) \
                (x == y) || (x != NULL) && (y != NULL) && \
                    (((OB)x)->header.tag == ((OB)y)->header.tag) && \
                                               gen_SYS_ob_eq((OB)x,(OB)y)

/* JN/kh:  new REFERENCE class builtins */

#define SYSEXTOBVAL(x)            (void *)(((CARD_boxed)(x))->immutable_part)
#define SYSEXTOBPTR(x)            (void *)(&(x))
#define SYSEXTOBFOR(x)            (void *)x
#define SYSCREATEOBJ(x,y)         sys_create_obj(x, y)
#define SYSCREATEOBJSIZED(x,y,z)  sys_create_obj_sized(x, y, z)

/********** CHAR **********/

#define CHARAGET(c,b)   CHK_BOUNDS(b,0,7,(CHAR)((c & (1 << b)) != 0))
#define CHARASET(c,b,v) CHK_BOUNDS(b,0,7,(CHAR)((c & (~(1 << b))) | (v << b)))

/********** FSTR **********/

#define FSTRASET(f,i,c) CHK(f,CHK_BOUNDS(i,0,f->loc - 1,(f)->arr_part[i] = c))
#define FSTRAGET(f,i)   CHK(f,CHK_BOUNDS(i,0,f->loc - 1,(f)->arr_part[i]))
#define FSTRACOPY(f,s)  CHK(s,CHK(f,CHK_BOUNDS(ASIZE(s),0,ASIZE(f), \
                            (memcpy((f)->arr_part,(s)->arr_part,ASIZE(s))))))
#define FSTRACOPYF(f,f2) CHK(f2,CHK(f,CHK_BOUNDS(f2->loc,0,ASIZE(f), \
                            (memcpy((f)->arr_part,(f2)->arr_part,f2->loc)))))
#define FSTRACOPYN(f,s,n) CHK(s,CHK(f,CHK_BOUNDS(n,0,ASIZE(f), \
           CHK_BOUNDS(n,0,ASIZE(s),(memcpy((f)->arr_part,(s)->arr_part,n))))))
#define FSTRACOPYNF(f,f2,n) CHK(f2,CHK(f,CHK_BOUNDS(n,0,ASIZE(f), \
           CHK_BOUNDS(n,0,f2->loc,(memcpy((f)->arr_part,(f2)->arr_part,n))))))
#define FSTRACOPYIS(f,i,s) CHK(s,CHK(f,CHK_BOUNDS(i,0,ASIZE(f) - 1, \
        memcpy((f)->arr_part + i,(s)->arr_part,SAMIN(ASIZE(f) - i,ASIZE(s))))))
#define FSTRACOPYIF(f,i,f2) CHK(f2,CHK(f,CHK_BOUNDS(i,0,ASIZE(f) - 1, \
        memcpy((f)->arr_part + i,(f2)->arr_part,SAMIN(ASIZE(f) - i,f2->loc)))))

/********** STR **********/

#define STRAGET(s,i)    CHK(s,CHK_BOUNDS(i,0,ASIZE(s) - 1,(s)->arr_part[i]))
#define STRACOPYNF(s,f,n) CHK(s,CHK(f,CHK_BOUNDS(n,0,ASIZE(s), \
               CHK_BOUNDS(n,0,f->loc,memcpy((s)->arr_part,(f)->arr_part,n)))))
#define STRACOPYN(s,s2,n) CHK(s,CHK(s2,CHK_BOUNDS(n,0,ASIZE(s), \
           CHK_BOUNDS(n,0,ASIZE(s2),memcpy((s)->arr_part,(s2)->arr_part,n)))))
#define STRACOPYIS(s,i,s2) CHK(s2,CHK(s,CHKOK((ASIZE(s2) == 0) || ((i >= 0) && \
              (i<ASIZE(s))),"Bad precondition for STR::acopy", \
                    memcpy((s)->arr_part + i,(s2)->arr_part, \
                                         SAMIN(ASIZE(s) - i,ASIZE(s2))))))
#define STRISEQHELPER(s,s2,len) (memcmp((s)->arr_part,(s2)->arr_part,len) == 0)


#define STRAGETCARD(s,i)   str_aget_card(s,i)
#define STRASETCARDCHAR(s,i,c)   str_aset_card_char(s,i,c)


/********** AREF **********/

#define AREFACOPY(s,f)   CHK(s,CHK(f,memcpy((s)->arr_part,(f)->arr_part, \
                        sizeof((s)->arr_part[0]) * SAMIN(ASIZE(s),ASIZE(f)))))
#define AREFACOPYB(s,b,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,ASIZE(s), \
                    memcpy((s)->arr_part + b,(f)->arr_part, \
                    sizeof((s)->arr_part[0]) * SAMIN(ASIZE(s) - b,ASIZE(f))))))
#define AREFACOPYBN(s,b,n,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,ASIZE(s), \
                    CHK_BOUNDS(b + n,0,ASIZE(s),CHK_BOUNDS(n,0,ASIZE(f), \
                    memcpy((s)->arr_part + b,(f)->arr_part, \
                                  sizeof((s)->arr_part[0])*n))))))
#define AREFACOPYBNS(s,b,n,sr,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,ASIZE(s), \
                   CHK_BOUNDS(b + n,0,ASIZE(s),CHK_BOUNDS(sr,0,ASIZE(f), \
                      CHK_BOUNDS(n + sr,0,ASIZE(f),memcpy((s)->arr_part + b, \
                         (f)->arr_part + sr,sizeof((s)->arr_part[0]) * n)))))))
#define AREFACLEAR(s)    CHK(s,memset((s)->arr_part,0, \
                                       sizeof((s)->arr_part[0]) * ASIZE(s)))

/********** AVAL **********/

#define AVALACOPY(T,s,f)   CHK(s,CHK(f,memcpy(s.arr_part,f.arr_part, \
                                    sizeof(s.arr_part[0]) * VASIZE(T))))
#define AVALACOPYB(T,s,b,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,VASIZE(T), \
                                  memcpy(s.arr_part + b,f.arr_part, \
                                    sizeof(s.arr_part[0]) * VASIZE(T) - b))))
#define AVALACOPYBN(T,s,b,n,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,VASIZE(T), \
                    CHK_BOUNDS(b + n,0,VASIZE(T),CHK_BOUNDS(n,0,VASIZE(T),, \
                        memcpy(s.arr_part + b,f.arr_part, \
                                      sizeof(s.arr_part[0]) * n))))))
#define AVALACOPYBNS(T,s,b,n,sr,f) CHK(s,CHK(f,CHK_BOUNDS(b,0,VASIZE(T), \
                    CHK_BOUNDS(b + n,0,VASIZE(T),CHK_BOUNDS(sr,0,VASIZE(T), \
                                CHK_BOUNDS(n + sr,0,VASIZE(T), \
                                memcpy(s.arr_part + b,f.arr_part + sr, \
                                          sizeof(s.arr_part[0]) * n)))))))


/* JN:  New AVAL::aset and AVAL::aget builtins for objects builtup of bits */

/*
Old and wrong? (lets just keep it for a little while JIC (JN)
#define BIT_AVAL_ASET(el, bit, val, maxbits)  rt_aset(&el, bit, val, maxbits)
*/

#define BIT_AVAL_ASET(el, index, val, obsize)  rt_aset(&(el), index, val, obsize)
#define BIT_AVAL_AGET(el, index, obsize)       rt_aget(&(el), index, obsize)

#define AVALAGET8(SType,RType, ob, index) \
     CHK_BOUNDS(index,0,VASIZE(SType),((RType *)(&(ob)))[index])

#define AVALASET8(SType,ob,index,val) \
     CHK_BOUNDS(index,0,VASIZE(SType),((OCTET *)(&(ob)))[index] = (OCTET)val)

#define AVALAGET16(SType,RType, ob, index) \
     CHK_BOUNDS(index,0,VASIZE(SType),((RType *)(&(ob)))[index*2])

#define AVALASET16(SType,ob,index,val) \
     CHK_BOUNDS(index,0,VASIZE(SType),((HEXTET *)(&(ob)))[index*2] = (HEXTET)val)
