/*------------------------->  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 is required for inclusion at the head of the compiler
     produced sather.h header file.

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

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

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

        16 Oct 98        kh       Original from Sather 1.1 & 1.2 distributions.

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


#include <stdio.h>
#include <errno.h>
#include <math.h>
#include <string.h>

#if !defined(WIN32) && !defined(__riscos__)
     #include <sys/utsname.h>          /* needed for detecting RISC/os 5.01 */
#endif

#if defined(V_RISCOS) && defined(R_5_0) /* yoshida@agusa.nuie.nagoya-u.ac.jp */
     #ifndef _SETJMP_H
          #define _SETJMP_H
          #include <setjmp.h>
     #endif
#else
     #include <setjmp.h>
#endif

#include <setjmp.h>
#include <signal.h>
#include <limits.h>
#include <sys/types.h>
#include <stdlib.h>
#include <time.h>
#include <float.h>

#if !defined(__NeXT__) && !defined(WIN32)
     #include <unistd.h>
#endif

#if !defined(__NeXT__) && !defined(__EMX__) && !defined(__NetBSD__) && \
               !defined(__FreeBSD__) && !defined(WIN32) && !defined(__riscos__)
     #include <values.h>
#endif

#if defined(WIN32) && !defined(GCC)
/* From robert@crclund.abb.se */

     #include <io.h>

     #define lseek _lseek
     #define read _read
     #define open _open
     #define close _close

#ifndef O_RDONLY
     #define O_RDONLY _O_RDONLY
#endif

#endif /* WIN32 */

/* Determine the machine type: */

#if defined(__i386__) && defined(__sun__)
     #define SUNOS5
#endif

#if defined(sun) && defined(sparc)
     #define SPARC

               /* Test for SunOS 5.x */

     #include <errno.h>

     #ifdef ECHRNG
          #define SUNOS5
     #else
          #define SUNOS4
     #endif
#endif

#if defined(NeXT) && defined(mc68000)
     #define M68K
     #define NEXT
#endif

#if defined(vax)
     #define VAX

     #ifdef ultrix
          #define ULTRIX
     #else
          #define BSD
     #endif
#endif

#if defined(SPARC) && defined(SUNOS5) && defined(__SUNPRO_C)
     #include <sunmath.h>
#endif

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

          The name ZALLOCxxx is used to refer to a garbage collected malloc
     that returns zeroed memory.  The following pre-processing directives
     decide which garbage collectoin facility is to be used for the target
     platform.  The _LEAF and _BIG forms denote regions that will be free of
     pointers and that will be very large.  (The latter is needed by the Boehm
     collector to do with blacklisting.)  ZINIT does any initialization
     required by memory management.

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


#ifdef SIVA
     #define ZALLOC(x) 		((void*)SI_ALLOC(x))
     #define ZALLOC_LEAF(x) 	((void*)SI_ALLOC_LEAF(x))
     #define ZALLOC_BIG(x) 	((void*)SI_ALLOC(x))
     #define ZALLOC_LEAF_BIG(x)	((void*)SI_ALLOC_LEAF(x))
     #define ZFREE(x)		SI_dealloc(x)
#elsif defined ZONES
     #define ZALLOC(x) 		zalloc(x)
     #define ZALLOC_LEAF(x) 	zalloc_leaf(x)
     #define ZALLOC_BIG(x) 	zalloc(x)
     #define ZALLOC_LEAF_BIG(x)	zalloc_leaf(x)
     #define ZFREE(x)		zfree(x)
     #define ZINIT			zinit_globals();
#else
     #define ZALLOC(x)		GC_malloc(x)
     #define ZALLOC_LEAF(x)	GC_malloc_atomic(x)
     #define ZALLOC_BIG(x)		GC_malloc_ignore_off_page(x)
     #define ZALLOC_LEAF_BIG(x)	GC_malloc_atomic_ignore_off_page(x)
     #define ZFREE(x)		GC_free(x)
     #define ZINIT
#endif


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

          OBALLOC(x) returns a zeroed memory region of size and type x. The
     compiler emits typedefs such that "x_struct" is the name of the struct
     type that *x refers to.

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

#define OBALLOC(x) ((x) ZALLOC(sizeof(struct x##_struct)))

          /* For bootstrapping */

#define OB_ALLOC(x) OBALLOC(x)

#if defined(V_RISCOS) && defined(R_5_0) /* yoshida@agusa.nuie.nagoya-u.ac.jp */
     #ifndef _MAXFLOAT
          #define _MAXFLOAT
          #define MAXFLOAT          ((float)3.40282346638528860e+38)
     #endif

     #define M_LOG2E             1.4426950408889634074
#endif

          /* Layouts for the Sather classes which are built-in */

typedef struct {
          short tag ;
#ifdef DESTROY_CHK
          char destroyed ;
#endif

#ifdef DETERMINISTIC
         unsigned int id ;
#endif
         } OB_HEADER ;

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

          Builtin Types

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

#define TRUE     1
#define FALSE    !TRUE

#define SETBIT   1
#define CLEARBIT !SETBIT

#ifdef WIN32

#include <asm/types.h>
     
typedef __u8      BOOL;
typedef __u8      BIT ;
typedef __u32     CARD ;
typedef __u32     FIELD ;
typedef __s32     INT ;
typedef __u32     CHAR ;

typedef __u8      OCTET ;
typedef __u16     HEXTET ;
typedef __u32     QUADBITS ;

#define SINT_MAX   INT_MAX
#define SINT_MIN   INT_MIN
#define SCARD_MAX  UINT_MAX

#else

typedef unsigned char BOOL ;
typedef unsigned char BIT ;

/* If these types (3 below) are not available in the compiler implementation
** you have you will need to size the types accordingly (JN) */

#include <asm/types.h>

typedef __u8      OCTET ;
typedef __u16     HEXTET ;
typedef __u32     QUADBITS ;
typedef __u32     CHAR ;

#ifdef ALPHA
     
typedef unsigned int  CARD ;
typedef unsigned int  FIELD ;
typedef int           INT ;
 
#define SINT_MAX       INT_MAX
#define SINT_MIN       INT_MIN
#define SCARD_MAX      UINT_MAX

#else
     
typedef unsigned long  CARD ;
typedef unsigned long  FIELD ;
typedef long           INT ;

#define SINT_MAX        LONG_MAX
#define SINT_MIN        LONG_MIN
#define SCARD_MAX       ULONG_MAX

#endif
#endif

typedef float FLT ;
typedef double FLTD ;
typedef double FLTX ;                        /* This is a hack */
typedef double FLTDX ;                       /* This is also a hack! */
typedef void* EXT_OB ;                       /* Boot use for REFERENCE */
typedef void* REFERENCE ;
typedef float ANGLE ;
typedef double ANGLED ;

#ifndef PSATHER

typedef void *GATE ;
typedef void *MUTEX ;
typedef long THREAD_ID ;
typedef struct THREAD_ID_boxed_struct {
                            OB_HEADER header ;
                            THREAD_ID immutable_part ;
                            } *THREAD_ID_boxed ;
                            
     #define THR_HASH(x)               x
     #define thr_print_id(x,y)
     #define LOCK_HEADER_STRUCT
     #define LOCK_HEADER_STRUCT_REFS
     #define THREAD_ID_zero            (long)0
     #define THREAD_ID_IS_EQ(a,b)      ((a) == (b))
     #define THREAD_ID_IS_VOID(a)      ((a) == 0)
#endif

          /* Little boxes made of ticky-tacky */



typedef struct BIT_boxed_struct {
                       OB_HEADER header ;
                             BIT immutable_part ;
                                } *BIT_boxed ;
                      
typedef struct OCTET_boxed_struct {
                       OB_HEADER header ;
                           OCTET immutable_part ;
                                } *OCTET_boxed ;

typedef struct HEXTET_boxed_struct {
                       OB_HEADER header ;
                          HEXTET immutable_part ;
                                } *HEXTET_boxed ;

typedef struct QUADBITS_boxed_struct {
                       OB_HEADER header ;
                        QUADBITS immutable_part ;
                                } *QUADBITS_boxed ;
          
typedef struct CARD_boxed_struct {
                        OB_HEADER header ;
                             CARD immutable_part ;
                                  } *CARD_boxed ;
                                  
typedef struct FIELD_boxed_struct {
                         OB_HEADER header ;
                             FIELD immutable_part ;
                                   } *FIELD_boxed ;

typedef struct BOOL_boxed_struct {
                        OB_HEADER header ;
                             BOOL immutable_part ;
                                  } *BOOL_boxed ;
                                  
typedef struct CHAR_boxed_struct {
                        OB_HEADER header ;
                             CHAR immutable_part ;
                                  } *CHAR_boxed ;
                                  
typedef struct INT_boxed_struct {
                       OB_HEADER header ;
                             INT immutable_part ;
                                 } *INT_boxed ;
                                 
typedef struct FLT_boxed_struct {
                       OB_HEADER header ;
                             FLT immutable_part ;
                                 } *FLT_boxed ;
                                 
typedef struct FLTD_boxed_struct {
                        OB_HEADER header ;
                             FLTD immutable_part ;
                                  } *FLTD_boxed ;
                                    
typedef struct ANGLE_boxed_struct {
                       OB_HEADER header ;
                             ANGLE immutable_part ;
                                 } *ANGLE_boxed ;
                                 
typedef struct ANGLED_boxed_struct {
                        OB_HEADER header ;
                             ANGLED immutable_part ;
                                  } *ANGLED_boxed ;
                                 
typedef struct FLTX_boxed_struct {
                        OB_HEADER header ;
                             FLTX immutable_part ;
                                  } *FLTX_boxed ;
                                  
typedef struct FLTDX_boxed_struct {
                         OB_HEADER header ;
                             FLTDX immutable_part ;
                                   } *FLTDX_boxed ;
                                   
typedef struct EXT_OB_boxed_struct {
                          OB_HEADER header ;
                             EXT_OB immutable_part ;
                                    } *EXT_OB_boxed ;

typedef struct REFERENCE_boxed_struct {
                          OB_HEADER header ;
                             EXT_OB immutable_part ;
                                    } *REFERENCE_boxed ;

typedef struct STR_struct {
                          OB_HEADER header ;
                                INT asize ;
                               CARD priv_lib ;
                               CARD width1 ;
                              OCTET arr_part[1] ;
                                    } *STR ;

typedef struct iter_frame_stub_struct {      /* iter frame header struct */
                                   INT state ;
                                       } *iter_frame_stub ;

typedef struct OB_struct {
                OB_HEADER header ;
                          } *OB ;

#define BIT_zero              (BIT)0
#define CARD_zero             (CARD)0
#define OCTET_zero            (OCTET)0
#define HEXTET_zero           (HEXTET)0
#define QUADBITS_zero         (QUADBITS)0
#define FIELD_zero            (FIELD)0 
#define REFERENCE_zero        (REFERENCE)0
#define ANGLE_zero            (ANGLE)0
#define ANGLED_zero           (ANGLED)0

#define INT_zero              (INT)0
#define BOOL_zero             (BOOL)0
#define CHAR_zero             (CHAR)0
#define FLTD_zero             (FLTD)0
#define FLT_zero              (FLT)0
#define FLTX_zero             (FLTX)0
#define FLTDX_zero            (FLTDX)0
#define EXT_OB_zero           (EXT_OB)0

#define STD_IS_EQ(a,b)        ((a) == (b))

#define BIT_IS_EQ(a,b)        STD_IS_EQ(a,b)
#define OCTET_IS_EQ(a,b)      STD_IS_EQ(a,b)
#define HEXTET_IS_EQ(a,b)     STD_IS_EQ(a,b)
#define QUADBITS_IS_EQ(a,b)   STD_IS_EQ(a,b)
#define CARD_IS_EQ(a,b)       STD_IS_EQ(a,b)
#define FIELD_IS_EQ(a,b)      STD_IS_EQ(a,b)
#define REFERENCE_IS_EQ(a,b)  STD_IS_EQ(a,b)
#define ANGLE_IS_EQ(a,b)      STD_IS_EQ(a,b)
#define ANGLED_IS_EQ(a,b)     STD_IS_EQ(a,b)

#define INT_IS_EQ(a,b)        STD_IS_EQ(a,b)
#define BOOL_IS_EQ(a,b)       STD_IS_EQ(a,b)
#define CHAR_IS_EQ(a,b)       STD_IS_EQ(a,b)
#define FLTD_IS_EQ(a,b)       STD_IS_EQ(a,b)
#define FLT_IS_EQ(a,b)        STD_IS_EQ(a,b)
#define FLTX_IS_EQ(a,b)       STD_IS_EQ(a,b)
#define FLTDX_IS_EQ(a,b)      STD_IS_EQ(a,b)
#define EXT_OB_IS_EQ(a,b)     STD_IS_EQ(a,b)

#define BIT_IS_VOID(a)        ((a)==0)
#define OCTET_IS_VOID(a)      ((a)==0)
#define HEXTET_IS_VOID(a)     ((a)==0)
#define QUADBITS_IS_VOID(a)   ((a)==0)
#define CARD_IS_VOID(a)       ((a)==0)
#define FIELD_IS_VOID(a)      ((a)==0)
#define REFERENCE_IS_VOID(a)  ((a)==0)
#define ANGLE_IS_VOID(a)      ((a) == 0.0)
#define ANGLED_IS_VOID(a)     ((a) == 0.0)

#define INT_IS_VOID(a)        ((a) == 0)
#define BOOL_IS_VOID(a)       ((a) == 0)
#define CHAR_IS_VOID(a)       ((a) == 0)
#define FLTD_IS_VOID(a)       ((a) == 0.0)
#define FLT_IS_VOID(a)        ((a) == 0.0)
#define FLTX_IS_VOID(a)       ((a) == 0.0)
#define FLTDX_IS_VOID(a)      ((a) == 0.0)
#define EXT_OB_IS_VOID(a)     ((a) == 0)

#undef ferror
#undef feof

#include "floatmath.h"                  /* include floating-point support */

#ifndef PSATHER                    /* pSather has its own exception handling */
     #include "exception.h"        /* include exception handling support */
#endif

STR gen_SYS_str_for_tp(INT) ;
BOOL gen_SYS_ob_eq(OB,OB) ;

#define IS_ITER 0

          /* include stuff for interfacing other languages */
          
#include "fortran.h"
#include "c.h"

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

          The definition of multiple tables (mostly generated by the compiler).
     Those tables are used for  --
     
          *- GC
          *- Debugging
          *- to move data between clusters (pSather)

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


extern char *source_files[] ;           /* for error messages and debugging */

extern int sather_type_offset ;

struct sather_attribute {
                   char *sather_name ;
                   char *c_name ;
                     int type ;
                    long offset ;
                    long source ;
                         } ;

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

          The refs component of the following structure is a list of offsets
     for reference objects, terminated with -1, and void if the object has
     no references at all. This information is obviously redundant, but speeds
     up pSather and GC. References in embedded value type objects have to be
     mentioned too!

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

extern struct sather_type_description {
                                  int *refs ; 
                                 char *sather_name ;
                                 char *c_name ;
                                  long source ; /*   source file and line where
                                                     it is defined */
                                   int size ;
                                   int boxed ;  /* only immutable types */
                                   int attrs ;  /* No of attributes */
                              unsigned is_immutable : 1 ;
                              unsigned is_ref : 1 ;
                              unsigned is_abstract : 1 ;
                              unsigned is_bound : 1 ;
                              unsigned is_ext : 1 ;
                              unsigned is_aref : 1 ;

                                            /*   last attr describes array */
               struct sather_attribute attr[1] ;
                                       } **sather_types ;

extern struct sather_function_definition {
                                   void (*cfunc)() ;  /* ptr to C function */
                                     long source ;    /* sather file */
                                    char *sather_name ;
                                    char *c_name ;
                                      int args ;      /* no. of actual args */
                                      int locals ;    /* number of locals */
                  struct sather_attribute attr[1] ;   /* args then locals */
                                          } *sather_functions[] ;

struct _func_frame {
               long func ;
struct _func_frame *prev ;
             void **args ;       /* args[0]=self, first args, then locals */
                    } ;

extern char *sather_prog_name ;

