/*------------------------->  ANSI C - sourcefile  <-------------------------*/
/* 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 all of the routines needed by the Sather engine
     irrespective of any underlying operating system.

     NOTE The routines do use the ZALLOCxxx family of macros as well as the
          FATAL macro which is operating system dependent (if, of course,
          there is an operating system at all).

          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.

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

#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/file.h>
#include <fcntl.h>
#include <stdio.h>
#include <memory.h>
#define RUNTIME
#include "sather.h"
#include "tags.h"

#ifdef _POSIX_SOURCE
#include <signal.h>
#endif


#if defined(WIN32) || defined(linux)
FLT quiet_nan(INT n){
  fprintf(stderr, "quiet_nan(INT n) called but not implemented\n") ;
  fflush(stderr) ;
  exit(1) ;
}
#endif

/* (JN) 21/4/99 - The next two routines are for the new library */

CHAR str_aget_card(STR self, CARD index)
{
  CHAR res ;
  CARD width = self->width1 ;
  OCTET *arr = self->arr_part ;

  switch (width) {
  case 1:
    res = (CHAR)(arr[index]) ;
    break ;
  case 2:
    res = (CHAR)(*((HEXTET *)&arr[index*2])) ;
    break ;
  case 4:
    res = *((CHAR *)&arr[index*4]) ;
    break ;
  default:
    FATAL("aget:  STR object width must be either 1, 2, or 4 octets") ;
  }
  return res ;
}

void str_aset_card_char(STR self, CARD index, CHAR val)
{
  CHAR res ;
  CARD width = self->width1 ;
  OCTET *arr = self->arr_part ;

  switch (width) {
  case 1:
    arr[index] = (OCTET)val ;
    break ;
  case 2:
    *((HEXTET *)&arr[index*2]) = (HEXTET)val ;
    break ;
  case 4:
    *((CHAR *)&arr[index*4]) = val ;
    break ;
  default:
    FATAL("aset:  STR object width must be either 1, 2, or 4 octets") ;
  }
}



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

          The following group of routines are about setting/testing individual
     bits in floating point numbers.

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


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

          The following routine sets/clears an individual bit in a storage
     object buf.

     NOTE Although it is an error for this routine to be given a bit number
          which is greater than or equal to maxbits, this should only occur
          if there is an error in the Sather compiler or pre-condition checking
          during execution has been turned off

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

void rt_aset(void *buf, INT bit_index, BIT val, INT maxbits) {

     INT word_index,mask,*ptr ;

     if (bit_index < 0 || bit_index >= maxbits) {
       FATAL("aset index out of range") ;
     } ;

     word_index = bit_index / (sizeof(INT) * 8) ;
     bit_index = bit_index % (sizeof(INT) * 8) ;
     mask = ~(1 << bit_index) ;
     ptr = ((INT*) buf) + word_index ;
     *ptr = ((*ptr) & mask) | (val << bit_index) ;
     }

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

          The following routine returns set if and only if the indicated bit
     of buf is set, otherwise 'false'.

     NOTE Although it is an error for this routine to be given a bit number
          which is greater than or equal to maxbits, this should only occur
          if there is an error in the Sather compiler or pre-condition checking
          during execution has been turned off

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


BIT rt_aget(void *buf, INT bit_index, INT maxbits) {

     INT word_index, *ptr ;

     if (bit_index < 0 || bit_index >= maxbits) {
       FATAL("aget index out of range") ;
     } ;

     word_index = bit_index / (sizeof(INT) * 8) ;
     bit_index = bit_index % (sizeof(INT) * 8) ;
     ptr = ((INT *) buf) + word_index ;
     return (BIT)(((*ptr) & (1 << bit_index)) != 0) ;
     }

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

          The following routine uses rt_aset to set/clear an individual bit
     of a single precision floating point number.

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


FLT rt_flt_aset(FLT f,INT bit,BOOL val) {
     rt_aset(&f,bit,val,32) ;
     return f ;
     }

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

          The following routine uses rt_aget to return whether or not a
     particular bit of a single precision floating point number is set.

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


BOOL rt_flt_aget(FLT f, INT bit) {
     return rt_aget(&f, bit, 32) ;
     }

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

          The following routine uses rt_aset to set/clear an individual bit
     of a double precision floating point number.

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


FLTD rt_fltd_aset(FLTD f, INT bit, BOOL val) {
     rt_aset(&f, bit, val, 64) ;
     return f ;
     }

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

          The following routine uses rt_aget to return whether or not a
     particular bit of a double precision floating point number is set.

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


BOOL rt_fltd_aget(FLTD f, INT bit) {
     return rt_aget(&f, bit, 64) ;
     }


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

        The following two routines have been included by courtesy of Erik
   Schnetter and are 'endian' independent while conforming to IEEE 754.

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


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

          This routine gets the internal representation from a single precision
     floating point number.

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


void rt_flt_get_rep(FLT f,BOOL* neg,INT* ex,INT* m) {

     int i = 1
     ;
     if (*(char *) &i) {                     /* little endian */
          union {
                 FLT f ;
                 struct {                    /* from ieeefp.h in Gnu library */
                         unsigned int mantissa : 23 ;
                         unsigned int exponent : 8 ;
                         unsigned int negative : 1 ;
                         } fields ;
                 } x ;

          x.f = f ;
          *neg = x.fields.negative ;
          *ex = x.fields.exponent ;
          *m = x.fields.mantissa ;
          }
     else {                                  /* big endian */
          union {
                 FLT f ;
                 struct {                    /* from ieeefp.h in Gnu library */
                          unsigned int negative : 1 ;
                          unsigned int exponent : 8 ;
                          unsigned int mantissa : 23 ;
                          } fields ;
                  } x ;

          x.f = f ;
          *neg = x.fields.negative ;
          *ex = x.fields.exponent ;
          *m = x.fields.mantissa ;
          }
     }

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

          This routine gets the internal representation from a double precision
     floating point number.

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


void rt_fltd_get_rep(FLTD f,BOOL* neg,INT* ex,INT* m1, INT* m0) {

     int i = 1
     ;
     if (*(char *) &i) {                     /* little endian */
          union {
                 FLTD f ;
                 struct {                    /* from ieeefp.h in Gnu library */
                         unsigned int mantissa1 : 32 ;
                         unsigned int mantissa0 : 20 ;
                         unsigned int exponent : 11 ;
                         unsigned int negative : 1 ;
                         } fields ;
                 } x ;

          x.f = f ;
          *neg = x.fields.negative ;
          *ex = x.fields.exponent ;
          *m0 = x.fields.mantissa0 ;
          *m1 = x.fields.mantissa1 ;
          }
     else {                                  /* big endian */
          union {
                 FLTD f ;
                 struct {                    /* from ieeefp.h in Gnu library */
                         unsigned int negative : 1 ;
                         unsigned int exponent : 11 ;
                         unsigned int mantissa0 : 20 ;
                         unsigned int mantissa1 : 32 ;
                          } fields ;
                  } x ;

          x.f = f ;
          *neg = x.fields.negative ;
          *ex = x.fields.exponent ;
          *m0 = x.fields.mantissa0 ;
          *m1 = x.fields.mantissa1 ;
          }
     }


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

          The following routine splits concatenated strings separated by '\0'
     into array of strings

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

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

     char **ptr ;
     int i ;

     ptr = (char **) malloc (sizeof (char *) * size) ;

     for (i = 0 ; (i < size) && (*s != 0) ; i++) {
          ptr[i] = s ;
          s = (char *) (s + strlen(s) + 1) ;
          } ;

     return  ptr ;
     }


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

          The following routine allocates a simple array for use in thread
	 name production for debugging.

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

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

     void *res ;

     res = (void *) ZALLOC_BIG(size1 + (n - 1) * size2) ;

     if (res == NULL) FATAL("Unable to allocate more memory") ;
     ((OB)res)->header.tag = tag ;

#ifdef DESTROY_CHK
     ((OB)res)->header.destroyed = 0 ;  /* Just allocated - do without GC?? */
#endif

#ifdef DETERMINISTIC
     ((OB)res)->header.id = ob_count++ ;
#endif

     return res ;
     }

