/*------------------------->  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 those features of the Sather run-time which depend
    directly on operating system support, particularly for floating point
    number manipulation and pSather concurrency features.

          It has been heavily amended from the original Sather 1.2 distributed
     version, partly by separating out file/timer, etc features to other files
     to make this easier to read and partly as the result of a deliberate
     attempt to reduce the overhead and permit the running of Sather programs
     not using any operating system facilities.

          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 <stdio.h>
#include <unistd.h>
#include <time.h>

#include "sather.h"
#ifndef OLD_SATHER_LIBRARY
/* this check may be removed as soon as the Pre-Sather-W library is not used any more */
#include "tags.h"

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

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

          The following dummy function definition is necessary under some
     C compilers which insist on some data area in each file.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
struct _func_frame FF;


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

          For exception handling, a global buffer storing the state information
     needed to longjmp back to the dynamically most recent protect statement.
     Also needed is a global for returning the exception value.

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

jmp_buf last_protect ;

void *exception ;

static INT ob_count ;



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

          The two definitions following are required if IEEE FP support is
     present.

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


#if ~defined(SUNOS4)

double signaling_nan(int sig) {
     return 0.0 / 0.0 ;
     } ;
     
double infinity() {
     return 1.0 / 0.0 ;
     } ;
     
#endif

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

          The following platform dependent variations have been provided by
     stoehr@informatik.tu-muenchen.de

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

#if defined(__hpux) || defined(linux) || defined(__NEXT__)

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

          The following routine is not provided in the libraries as indicated
     by the defines above - is required - and given here.

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

double scalbn(double v, int n) {

     int i,nn ;
     double res ;

     res = 1.0 ;
     nn = abs(n) ;
     
     for (i=0; i<nn; i++) {
          res += res ;
          } ;
          
     if (n < 0) {
          return (v / res) ;
          } ;
          
     return(v * res) ;
     }
     
#endif

#if defined (hpux)

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

          Tha above operating system uses a special version of getcwd, so this
     has to be replazced by the standard version here.

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


char *getwd(char *a) {
     return(getcwd(a,1023)) ;
     }
     
#endif



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

          The remaining routines are all special for use with the Gnu debugger
     gdb - and will only work correctly with that debugger!

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


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

    The following routine is provided as a signal handler for use by gdb.

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

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

          This routine is used to start up the gdb debugger on the current
     cluster.

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


void start_gdb(int stop) {

     short c ;
     
#ifdef PSATHER
     int i ;

     extern void break_psather(void *) ;
     void volatile (*f)(void *) = (void *)break_psather ;

     if(getenv("START_GDB") == NULL) {
          return ;
          } ;
          
     remote_gdb(HERE) ;

          /*   in pSather the cluster is not stopped, but the same function is
               called in an endless loop.  The function should not be inlined,
               so that a breakpoint may be used in gdb to stop this thread) */
               
     while(1) {
          (*f)(&f) ;
          }

#else

     if(getenv("START_GDB") == NULL) {
          return ;
          } ;
          
     fprintf(stderr,"Please type 'g' if you want to start gdb,\n") ;
     fprintf(stderr,"any other key will abort this program\n") ;
     fflush(stderr) ;
     
     c = getchar() ;
     
     if (c == 'g') {
          char com[200] ;
          
          fprintf(stderr,"Starting gdb ...\n") ;
          fflush(stderr) ;
          sprintf(com,"gdb %s %d",sather_prog_name,getpid()) ;

          if (fork() == 0) {
               system(com) ;
               exit(0) ;
               } ;
               
          if (stop) {
               while(1) {
                    sleep(1) ;
                    }
               }
          }

#endif

     }


void gdb_signal_handler(int sig) {

     static int in_handler = 0 ;
     
#ifdef PSATHER
     fprintf(stderr,"CLUSTER %d: ",HERE) ;
#endif

     fprintf(stderr,"signal %d caught ... \n",sig) ;
     fflush(stderr) ;
     
     if (getenv("START_GDB") == NULL) {
          abort() ;
          } ;
          
     if (!in_handler) {
          in_handler = 1 ;
          
          if (sig == 3) {
	    start_gdb(0) ;
	  }
          else {
	    start_gdb(1) ;
	  }
     }
     else {
       if (sig != 3) {
	 while(1) ;
       }
     }
          
     if (sig != 3) {
          abort() ;
          } ;
     }


#ifdef PSATHER                               /* special for multiple clusters */


volatile static int gdb_already_started = 0 ;
                                        /* volatile because of threads! */

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

          The following routine is called when debugging to establish debugging
     on remote processor clusters which do not share memory with this one.

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

void remote_gdb(vnn_t from) {

     char com[300] ;                         /* Comms buffer space! */
     
     if (gdb_already_started) {
          return ;
          } ;
          
     gdb_already_started = 1 ;
     
     if (getenv("START_GDB") == NULL) {
          return ;
          } ;
          
     fprintf(stderr,"Starting gdb for cluster %d ...\n",HERE) ;
     fflush(stderr) ;
     
     if (getenv("START_GDB_COMMAND") != NULL) {
          sprintf(com,"%s %s %d",getenv("START_GDB_COMMAND"),
                                         sather_prog_name,getpid()) ;
          }
     else {
          sprintf(com,"xterm -fn 7x13 -T \"gdb for cluster %d\" -e gdb %s %d&",
                                     HERE,sather_prog_name,getpid()) ;
          } ;
                                     
     printf("system(%s)\n",com) ;
     system(com) ;
     }
     
#endif

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

          The following routine is used by the Sather engine when starting
      a program in order to set up appropriate signal handlers.

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




void rt_start(char *executable) {

#ifdef PSATHER
     signal(SIGQUIT,remote_gdb) ;
#else
     signal(SIGQUIT,gdb_signal_handler) ;
#endif

     signal(SIGILL,gdb_signal_handler) ;
     signal(SIGBUS,gdb_signal_handler) ;
     signal(SIGSEGV,gdb_signal_handler) ;

#if defined(linux)            /* Ignore the SIGFPE signal (arithmetic error).*/
     signal(SIGFPE,SIG_IGN) ;
#else
     signal(SIGFPE,gdb_signal_handler) ;
#endif

          /* The following two signals do not always exist! */

#ifdef SIGEMT
     signal(SIGEMT,gdb_signal_handler) ;
#endif

#ifdef SIGSYS
     signal(SIGSYS,gdb_signal_handler) ;
#endif


#ifdef STATS
     time_at_start = time(NULL) ;
#endif
}

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

          The following variables and routine (which could be empty depending
     on the pre-compiler definitions) is called after successful program
     termination.

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


#ifdef STATS
int rt_dispatches = 0 ;
time_t time_at_start ;
#endif


void rt_stop() {

#ifdef STATS
     fprintf(stderr,"\nRuntime statistics:\n\n") ;
     fprintf(stderr,"    Dispatched calls:      %d\n",rt_dispatches) ;
     
     #ifndef ZONES
          fprintf(stderr,"    Number of collections: %d\n",GC_gc_no) ;
          GC_gcollect();
          fprintf(stderr,"    Live heap at end:      %d Kb\n",
                                   GC_get_heap_size() / 1024) ;
     #endif
     
     fprintf(stderr,"    Execution wall time:   %d secs\n\n",
                                          time(NULL) - time_at_start) ;
#endif

     }


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

          The object which follows is used for holding the program name
     for use when using the special pSather debugging facilities.

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


char *sather_prog_name ;


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

          This following routine is used to catch void references as may be
     signalled by the operating system.  It will need replacing when there
     is NO operating system.

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

void rt_segfault_handler() {
     FATAL("Attribute or array access of void") ;
     }


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

          The following routine is not declared void so that warnings do not
     arise when the result is used in-line during arithmetic and bounds checks.

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


int rt_fatal(char *file, int line, char *msg) {
     fprintf(stderr,"%s:%d: Runtime error - %s\n",file,line,msg) ;
     fflush(stderr) ;
     start_gdb(1) ;
     
#ifdef PSATHER
     PSATHER_ABORT ;
#endif

     abort() ;
     }

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

          The following routine is not declared void so that warnings do not
     arise when the result is used in-line during arithmetic and bounds checks.
     Note that it has two message string arguments instead of the one above.

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


int rt_fatal_2(char *file, int line, char *msg,char *str) {
     fprintf(stderr,"%s:%d: Runtime error - %s, %s\n",file,line,msg,str) ;
     fflush(stderr) ;
     start_gdb(1) ;
     
#ifdef PSATHER
     PSATHER_ABORT ;
#endif

     abort() ;
     }

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

          The following routine is a version of the single message string
     routine above for use when the program is not running under gdb and there
     is no symbolic information available at run-time.

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


int rt_fatal2(char *msg) {
     fprintf(stderr,"Runtime error - %s\n",msg) ;
     fprintf(stderr,"(Use \"-debug\" to compile symbolic info)\n") ;
     fflush(stderr) ;
     start_gdb(1) ;
     
#ifdef PSATHER
     PSATHER_ABORT ;
#endif

     abort() ;
     }

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

          The following routine is a version of the double message string
     routine above for use when the program is not running under gdb and there
     is no symbolic information available at run-time.

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


int rt_fatal2_2(char *msg,char *str) {
     fprintf(stderr,"Runtime error - %s, %s\n",msg,str) ;
     fprintf(stderr,"(Use \"-debug\" to compile symbolic info)\n") ;
     fflush(stderr) ;
     start_gdb(1) ;
     
#ifdef PSATHER
     PSATHER_ABORT ;
#endif

     abort() ;
     }

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

   To fix type problem associated with macros in stdio.h

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

void fclearerr(REFERENCE fyle) {clearerr((FILE *)fyle) ;}


#endif  /* ifndef OLD_SATHER_LIBRARY */
/* this check may be removed as soon as the Pre-Sather-W library is not used any more */
