/****************************************************************************
**  SCALASCA    http://www.scalasca.org/                                   **
*****************************************************************************
**  Copyright (c) 1998-2012                                                **
**  Forschungszentrum Juelich GmbH, Juelich Supercomputing Centre          **
**                                                                         **
**  Copyright (c) 2003-2008                                                **
**  University of Tennessee, Innovative Computing Laboratory               **
**                                                                         **
**  See the file COPYRIGHT in the package base directory for details       **
****************************************************************************/

/*
 *-----------------------------------------------------------------------------
 *
 *  EPIK Library (Event Processing Interface Kit)
 *
 *  - NEC SX ftrace compiler interface
 * 
 *-----------------------------------------------------------------------------
 */

#include <stdlib.h>
#include <string.h>

#include "epk_comp.h"
#include "epk_conf.h"
#include "esd_def.h"
#include "esd_run.h"
#include "esd_event.h"
#include "elg_error.h"

#if defined (ELG_OMPI) || defined (ELG_OMP)
#  include <omp.h>
#endif


/*--- Defines ----------------------------------------------------------------*/

#define HASH_MAX        1021
#define FUNC_NAME_MAX   1024


/*--- Static variables -------------------------------------------------------*/

static int necsx_init = 1;       /* is initialization needed? */


/*--- Function prototypes ----------------------------------------------------*/

extern char* vftr_getname();
extern int   vftr_getname_len();


/*
 *-----------------------------------------------------------------------------
 * Simple hash table to map function names to region identifiers
 *-----------------------------------------------------------------------------
 */

typedef struct HN {
  long id;            /* hash code (address of function name) */
  elg_ui4 elgid;      /* associated EPIK region identifier  */
  struct HN* next;
} HashNode;

static HashNode* htab[HASH_MAX];

/*
 * Stores EPIK region identifier `e' under hash code `h'
 */

static void epk_hash_put(long h, elg_ui4 e) {
  long id = h % HASH_MAX;
  HashNode *add = malloc(sizeof(HashNode));
  add->id = h;
  add->elgid = e;
  add->next = htab[id];
  htab[id] = add;
}

/*
 * Lookup hash code `h'
 * Returns EPILOG region identifier if already stored, otherwise ELG_NO_ID
 */

static elg_ui4 epk_hash_get(long h) {
  long id = h % HASH_MAX;
  HashNode *curr = htab[id];
  while ( curr ) {
    if ( curr->id == h ) {
      return curr->elgid;
    }
    curr = curr->next;
  }
  return ELG_NO_ID;
}


/*
 *-----------------------------------------------------------------------------
 * EPIK adapter interface
 *-----------------------------------------------------------------------------
 */

/*
 * Register new region with EPIK
 */

static elg_ui4 epk_register_region(const char* fname, const char *addr) {
  elg_ui4 rid;

  rid = esd_def_region(fname, ELG_NO_ID, ELG_NO_LNO, ELG_NO_LNO,
                       "USR", ELG_FUNCTION);
  epk_hash_put((long) addr, rid);
  return rid;
}

void epk_filter_status()
{
  const char* filter_file = epk_get(EPK_FILTER);
  if ( (filter_file != NULL) && strlen(filter_file) ) {
    elg_warning("EPK_FILTER file \"%s\" not supported for NEC SX compilers", filter_file);
  }
}


/*
 *-----------------------------------------------------------------------------
 * NEC SX ftrace compiler interface
 *-----------------------------------------------------------------------------
 */

/*
 * This function is called at the entry of each function
 * The call is generated by the NEC SX compilers
 */

void _ftrace_enter2_(void)
{
  char*   func     = vftr_getname();
  int     func_len = vftr_getname_len();
  char    fname[FUNC_NAME_MAX];
  int     fname_len;
  elg_ui4 rid;

  /* -- if not yet initialized, initialize EPIK -- */
  if ( necsx_init ) {
    esd_open();
    epk_comp_status = &epk_filter_status;
    necsx_init = 0;
  }

  /* -- create null-terminated C-string from provided function name -- */
  fname_len = ( func_len < FUNC_NAME_MAX ) ? func_len : (FUNC_NAME_MAX - 1);
  strncpy(fname, func, fname_len);
  fname[fname_len] = '\0';

  /* -- ignore NEC OMP runtime functions -- */
  if ( strchr(fname, '$') != NULL ) return;

  /* -- get region identifier -- */
  if ( (rid = epk_hash_get((long) func)) == ELG_NO_ID ) {
    /* -- region entered the first time, register region -- */
#   if defined (ELG_OMPI) || defined (ELG_OMP)
    if (omp_in_parallel()) {
#     pragma omp critical (epk_comp_register_region)
      {
        if ( (rid = epk_hash_get((long) func)) == ELG_NO_ID ) {
          rid = epk_register_region(fname, func);
        }
      }
    } else {
      rid = epk_register_region(fname, func);
    }
#   else
    rid = epk_register_region(fname, func);
#   endif
  }

  /* -- enter event -- */
  esd_enter(rid);
}

/*
 * This function is called at the exit of each function
 * The call is generated by the NEC SX compilers
 */

void _ftrace_exit2_(void) {
  char*   func     = vftr_getname();
  int     func_len = vftr_getname_len();
  char    fname[FUNC_NAME_MAX];
  int     fname_len;
  elg_ui4 rid;

  /* -- create null-terminated C-string from provided function name -- */
  fname_len = ( func_len < FUNC_NAME_MAX ) ? func_len : (FUNC_NAME_MAX - 1);
  strncpy(fname, func, fname_len);
  fname[fname_len] = '\0';

  /* -- ignore NEC OMP runtime functions -- */
  if ( strchr(fname, '$') != NULL ) return;

  /* -- get region identifier -- */
  rid = epk_hash_get((long) func);

  /* -- exit event -- */
  esd_exit(rid);
}

/*
 * This function is called at the exit of the program
 * The call is generated by the NEC SX compilers
 */

void _ftrace_stop2_(void) {
  /* -- exit event for main -- */
  esd_exit(ELG_NO_ID);
  esd_close();
}

/*
 *-----------------------------------------------------------------------------
 * NEC SX ftrace region interface
 *-----------------------------------------------------------------------------
 */

#include <ftrace.h>

/*
 * This function is called at the entry of each region
 * manually annotated in C/C++ source code
 */

int ftrace_region_begin(const char* label)
{
  elg_ui4 rid;

  /* -- if not yet initialized, initialize EPIK -- */
  if ( necsx_init ) {
    esd_open();
    epk_comp_status = &epk_filter_status;
    necsx_init = 0;
  }

  /* -- get region identifier -- */
  if ( (rid = epk_hash_get((long) label)) == ELG_NO_ID ) {
    /* -- region entered the first time, register region -- */
#   if defined (ELG_OMPI) || defined (ELG_OMP)
    if (omp_in_parallel()) {
#     pragma omp critical (epk_comp_register_region)
      {
        if ( (rid = epk_hash_get((long) label)) == ELG_NO_ID ) {
          rid = epk_register_region(label, label);
        }
      }
    } else {
      rid = epk_register_region(label, label);
    }
#   else
    rid = epk_register_region(label, label);
#   endif
  }

  /* -- enter event -- */
  esd_enter(rid);
  return 0;
}

/*
 * This function is called at the exit of each region
 * manually annotated in C/C++ source code
 */

int ftrace_region_end(const char* label) {
  elg_ui4 rid;

  /* -- get region identifier -- */
  rid = epk_hash_get((long) label);

  /* -- exit event -- */
  esd_exit(rid);
  return 0;
}

/*
 * This function is called at the entry of each region
 * manually annotated in Fortran source code
 */

void ftrace_region_begin_(const char* label)
{
  elg_ui4 rid;

  /* -- if not yet initialized, initialize EPIK -- */
  if ( necsx_init ) {
    esd_open();
    epk_comp_status = &epk_filter_status;
    necsx_init = 0;
  }

  /* -- get region identifier -- */
  if ( (rid = epk_hash_get((long) label)) == ELG_NO_ID ) {
    /* -- region entered the first time, register region -- */
#   if defined (ELG_OMPI) || defined (ELG_OMP)
    if (omp_in_parallel()) {
#     pragma omp critical (epk_comp_register_region)
      {
        if ( (rid = epk_hash_get((long) label)) == ELG_NO_ID ) {
          rid = epk_register_region(label, label);
        }
      }
    } else {
      rid = epk_register_region(label, label);
    }
#   else
    rid = epk_register_region(label, label);
#   endif
  }

  /* -- enter event -- */
  esd_enter(rid);
}

/*
 * This function is called at the exit of each region
 * manually annotated in Fortran source code
 */

void ftrace_region_end_(const char* label) {
  elg_ui4 rid;

  /* -- get region identifier -- */
  rid = epk_hash_get((long) label);

  /* -- exit event -- */
  esd_exit(rid);
}
