/* Statistics gathering */

#include "params.h"
#include "gambit.h"
#include "struct.h"
#include "os.h"
#include "mem.h"
#include "strings.h"
#include "run.h"


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


#define MAX_STAT_NAME_LENGTH 256

struct stat_rec {
  char *name;
  long count;
  struct stat_list *sub_parts;
  };

typedef struct stat_rec *STAT_PTR;

struct stat_list {
  struct stat_rec stat;
  struct stat_list *next;
  };

typedef struct stat_list *STAT_LIST_PTR;

char stat_name[MAX_STAT_NAME_LENGTH+1];
long stat_multiplier;

char *predefined_stats[] = PREDEFINED_STATS;

#define NB_PREDEFINED_STATS (sizeof(predefined_stats) / sizeof(char *))

char *events[] = EVENTS;

#define NB_EVENTS (sizeof(events) / sizeof(char *))

struct stat_rec stat_root;
STAT_PTR prof_category, event_prof_category;

PSTATE_PTR processor;

char *prog_filename;


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


void init_stats()
{ sstate->nb_stats = NB_PREDEFINED_STATS;
}


long alloc_stat( index )
long *index;
{ if (sstate->nb_stats >= MAX_NB_STATS) return 1;
  *index = sstate->nb_stats++;
  return 0;
}


void stats_clear( index )
long index;
{ sstate->ofile[index].stats_bot = 0;
  sstate->ofile[index].stats_top = 0;
}


void stats_begin( index )
long index;
{ sstate->ofile[index].stats_bot = sstate->nb_stats;
}


void stats_end( index )
long index;
{ sstate->ofile[index].stats_top = sstate->nb_stats;
}


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


char *ofile_start;


void read_ofile( index )
long index;
{ if (sstate->ofile[index].len == 0)
  { OS_FILE input;
    char *filename;
    long len;
    char *top;

    ofile_start = pstate->heap_old;
    top = ofile_start + (pstate->heap_mid - pstate->heap_bot);

    filename = string_append( sstate->ofile[index].ptr, ".O" );
    if (filename == NULL)
    { os_warn( "Local memory overflow\n", 0L ); os_quit(); }
    input = os_file_open_input( filename );
    if (input == -1)
    { os_warn( "Can't open %s\n", (long)filename ); os_quit(); }
    len = os_file_length( input );
    if (len < 0)
    { os_warn( "Read error on object file %s\n", (long)filename ); os_quit(); }

    if (ofile_start+len > top)
    { os_file_close( input ); os_warn( "Load memory overflow\n", 0L ); os_quit(); }

    if (os_file_read( input, ofile_start, len ) != len)
    { os_file_close( input ); os_warn( "Read error on object file %s\n", (long)filename ); os_quit(); }

    os_file_close( input );
  }
  else
    ofile_start = sstate->ofile[index].ptr;
}


char *parse_ptr;


char parse_stat_name()
{ long len = 0;
  long level = 0;
  long sign;
  char c = *(parse_ptr++);
  while ((c > ' ') || (level > 0))
    { if (len > MAX_STAT_NAME_LENGTH)
      { os_warn( "Stat name too long\n", 0L ); os_quit(); }
    stat_name[len++] = c;
    if (c == '(') level++; else if (c == ')') level--;
    c = *(parse_ptr++);
  }
  stat_name[len] = '\0';
  stat_multiplier = 0;
  while ((c > '\0') && (c <= ' ')) c = *(parse_ptr++);
  if (c == '-') { sign = -1; c = *(parse_ptr++); }
  else if (c == '+') { sign = 1; c = *(parse_ptr++); }
  else sign = 1;
  while ((c >= '0') && (c <= '9'))
  { stat_multiplier = stat_multiplier*10 + (c - '0');
    c = *(parse_ptr++);
  }
  stat_multiplier = sign * stat_multiplier;
  return c;
}


STAT_PTR enter_sub_part( s, name )
STAT_PTR s;
char *name;
{ STAT_LIST_PTR ptr = s->sub_parts;

  while (ptr != NULL)
  { char *p1 = ptr->stat.name, *p2 = name;
    while ((*p1 != '\0') && (*p1 == *p2)) { p1++; p2++; }
    if (*p1 == *p2) break; /* found entry */
    ptr = ptr->next;
  }

  if (ptr != NULL)
    return &ptr->stat;
  else
  { STAT_LIST_PTR new = (STAT_LIST_PTR)local_malloc8( (long)sizeof(struct stat_list) );
    if (new == NULL)
    { os_warn( "Couldn't allocate stat entry\n", 0L ); os_quit(); }

    new->stat.name = string_copy( name );
    if (new->stat.name == NULL)
    { os_warn( "Couldn't allocate stat entry name\n", 0L ); os_quit(); }

    new->stat.count = 0;
    new->stat.sub_parts = NULL;
    new->next = s->sub_parts;
    s->sub_parts = new;
    return &new->stat;
  }
}


void parse_sub_parts( s, count, c )
STAT_PTR s;
long count;
char c;
{ STAT_PTR sub;

  loop:

  while ((c > '\0') && (c <= ' ')) c = *(parse_ptr++);

  switch (c)
  { case ')': return;
    case '(': c = parse_stat_name();
              sub = enter_sub_part( s, stat_name );
              sub->count += stat_multiplier * count;
              parse_sub_parts( sub, count, c );
              c = *(parse_ptr++);
              goto loop;
    default:
      { os_warn( "Incorrect statistic format\n", 0L ); os_quit(); }
    }
}


void parse_stat( count )
long count;
{ char c = *(parse_ptr++);
  while ((c > '\0') && (c <= ' ')) c = *(parse_ptr++);
  if (c != '(')
  { os_warn( "Incorrect statistic format, '(' expected\n", 0L ); os_quit(); }
  c = *(parse_ptr++);
  parse_sub_parts( &stat_root, count, c );
}


void enter_stat( stat, index )
char *stat;
long index;
{ long count = processor->stats_counters[index];
  if (count > 0)
  { parse_ptr = stat; parse_stat( count ); }
}


void enter_prof_stat( adr, length, name )
long adr, length;
char *name;
{ long end = adr + length;
  if (name == NULL)
  { os_warn( "Local memory overflow\n", 0L ); os_quit(); }
  if ((adr >= (long)sstate->const_bot) && (end < (long)sstate->const_top))
  { short *p = &processor->prof_bot[(adr-(long)sstate->const_bot)>>PROF_SHIFT];
    long ticks = 0;
    long i;
    for (i=length+4; i>0; i -= 1<<PROF_SHIFT) { ticks += *p; *(p++) = 0; }
    if (ticks > 0)
    { long msec = os_ticks_to_msec( ticks );
      STAT_PTR s = enter_sub_part( prof_category, name );
      prof_category->count += msec;
      s->count += msec;
    }
  }
}


void add_prof_stat( msec, name )
long msec;
char *name;
{ if (msec > 0)
  { STAT_PTR s = enter_sub_part( prof_category, name );
    prof_category->count += msec;
    s->count += msec;
  }
}


void stats_compute_profile()
{ short *p;
  long ticks;
  long cpu = (pstate->cpu_times[0] - pstate->stats_cpu_times[0]) +
             (pstate->cpu_times[1] - pstate->stats_cpu_times[1]);
  
  prof_category = enter_sub_part( &stat_root, "profile" );

  for_each_glob_prim_proc( enter_prof_stat );

  p = processor->prof_bot;
  ticks = 0;
  while (p < processor->prof_top) ticks += *(p++);

  if (ticks > 0)
    add_prof_stat( os_ticks_to_msec( ticks ), "(non_global_procedures)" );

  add_prof_stat( cpu-prof_category->count, "(unaccounted_for)" );
}


#define EVENT(x,y) (((x)<<24)+(y))
#define EVENT_NUM(x) ((x)>>24)
#define EVENT_TIME(x) ((x) & 0xffffff)
#define REL_TIME(x) EVENT_TIME((x)-elog_start)
#define LATER(x,y) ((y)-(x) & 0x800000)
long *elog_ptr[MAX_NB_PROC], *elog_top[MAX_NB_PROC];
long elog_start, elog_end;

#define ELOG_BUF_SIZE 1024
char *elog_buf;
long elog_len;


void elog_setup( start_time, stop_time )
long start_time, stop_time;
{ long i;

  elog_start = EVENT_TIME(start_time);
  elog_end = EVENT_TIME(stop_time);

  for (i=SCM_obj_to_int(pstate->nb_processors)-1; i>=0; i--)
  { long *p1, *p2;
    processor = pstate->ps[i];
    p1 = processor->elog_ptr;
    p2 = processor->elog_top;
    while ((p1 < p2) && LATER(EVENT_TIME(p1[0]), elog_end)) p1++;
    while ((p1 < p2) && LATER(elog_start, EVENT_TIME(p2[-1]))) p2--;
    elog_ptr[i] = p1;
    elog_top[i] = p2;
  }
}


void elog_begin()
{ elog_buf = (char *)local_malloc8( (long)ELOG_BUF_SIZE );
  if (elog_buf == NULL)
  { os_warn( "Couldn't allocate elog buffer\n", 0L ); os_quit(); }
  elog_len = 0;
}


void elog_finish( output )
OS_FILE output;
{ if (elog_len > 0) os_file_write( output, elog_buf, elog_len );
}


void elog_char( output, c )
OS_FILE output;
char c;
{ elog_buf[elog_len++] = c;
  if (elog_len >= (long)ELOG_BUF_SIZE)
  { os_file_write( output, elog_buf, elog_len );
    elog_len = 0;
  }
}


void elog_long( output, val )
OS_FILE output;
long val;
{ char *p = (char *)&val;
  long i;
  for (i=(long)sizeof(val); i>0; i--)
  { elog_buf[elog_len++] = *p++;
    if (elog_len >= (long)ELOG_BUF_SIZE)
    { os_file_write( output, elog_buf, elog_len );
      elog_len = 0;
    }
  }
}


void elog_generate()
{ if (elog_start != elog_end)
  { OS_FILE output;
    long i;
    char *mark = local_mark();

    output = os_file_open_output( string_append( prog_filename, ".elog" ) );
    if (output == -1)
    { os_warn( "Can't open event log file\n", 0L ); os_quit(); }

    elog_begin();

    elog_long( output, 12L );
    elog_long( output, 1L );
    elog_long( output, 0x80000000L );
    elog_long( output, 2L );

    for (i=0; i<NB_EVENTS; i++)
    { long j, len = string_length( events[i] );
      elog_long( output, (((len+2+3)/sizeof(long))+2)*sizeof(long) );
      elog_long( output, 2L );
      elog_long( output, i+1 );
      for (j=0; j<len; j++) elog_char( output, events[i][j] );
      elog_char( output, '\0' );
      elog_char( output, '\0' );
      for (j=j+2; j%sizeof(long)!=0; j++) elog_char( output, '\0' );
    }

    for (i=0; i<SCM_obj_to_int(pstate->nb_processors); i++)
    { long *p;
      long len;
      p = elog_top[i];
      len = p-elog_ptr[i];
      elog_long( output, (len*3+5)*sizeof(long) );
      elog_long( output, 3L );
      elog_long( output, i );
      elog_long( output, 0L );
      elog_long( output, 20L );
      elog_long( output, 0L );
      while (len > 0)
      { long event = *(--p);
        len--;
        elog_long( output, REL_TIME(EVENT_TIME(event)) );
        elog_long( output, EVENT_NUM(event)+1 );
        elog_long( output, 0L );
      }
    }

    elog_finish( output );

    os_file_close( output );

    local_release( mark );
  }
}


void add_event_prof_stat( ticks, name )
long ticks;
char *name;
{ if (ticks > 0)
  { STAT_PTR s = enter_sub_part( event_prof_category, name );
    event_prof_category->count += ticks;
    s->count += ticks;
  }
}


void stats_compute_event_profile()
{ long *p;
  long i;
  long prof[NB_EVENTS];

  event_prof_category = enter_sub_part( &stat_root, "event_profile" );

  for (i=0; i<NB_EVENTS; i++) prof[i] = 0;

  p = elog_top[SCM_obj_to_int(processor->id)];
  if (p == elog_ptr[SCM_obj_to_int(processor->id)])
    prof[EVENT_IDLE] = REL_TIME(elog_end);
  else
  { long last_event_num = EVENT_IDLE;
    long last_event_time = 0;
    while (p > elog_ptr[SCM_obj_to_int(processor->id)])
    { long event = *(--p);
      long event_num = EVENT_NUM(event);
      long event_time = REL_TIME(EVENT_TIME(event));
      prof[last_event_num] += EVENT_TIME(event_time - last_event_time);
      last_event_num = event_num;
      last_event_time = event_time;
    }
    prof[last_event_num] += EVENT_TIME(REL_TIME(elog_end) - last_event_time);
  }

  for (i=0; i<NB_EVENTS; i++)
    add_event_prof_stat( prof[i], events[i] );
}


void stats_compute()
{ long index, i;

  stat_root.sub_parts = NULL;

  for (i=NB_PREDEFINED_STATS-1; i>=0; i--)
    enter_stat( predefined_stats[i], i );

  for (index=0; index<sstate->nb_ofiles; index++)
    if (sstate->ofile[index].stats_top >
        sstate->ofile[index].stats_bot )
    { read_ofile( index );
      for (i=sstate->ofile[index].stats_bot;
           i<sstate->ofile[index].stats_top;
           i++)
        enter_stat( ofile_start+sstate->stats_offsets[i], i );
    }

  if (sstate->profiling) stats_compute_profile();

  if (elog_start != elog_end) stats_compute_event_profile();
}


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


void sort_sub_parts( s )
STAT_PTR s;
{ STAT_LIST_PTR i = s->sub_parts;

  while (i != NULL)
  { STAT_LIST_PTR j = i->next, k = i;
    struct stat_rec temp;

    while (j != NULL)
    { if (j->stat.count > k->stat.count) k = j;
      j = j->next;
    }

    temp = i->stat; i->stat = k->stat; k->stat = temp;

    i = i->next;
  }
}


long thousanths( x, y )
long x, y;
{ while (x > 2147483) { x = x>>1; y = y>>1; }
  return x * 1000 / y;
}


void stats_write_sub_parts( output, s, indent )
OS_FILE output;
STAT_PTR s;
long indent;
{ STAT_LIST_PTR ptr;
  long newlines = 0;

  sort_sub_parts( s );

  ptr = s->sub_parts;
  while (ptr != NULL)
    if (ptr->stat.sub_parts != NULL)
    { newlines = 1; break; }
    else
      ptr = ptr->next;

  ptr = s->sub_parts;
  while (ptr != NULL)
  { long i, thous;
    os_file_printf( output, "\n", 0L );
    if (newlines) os_file_printf( output, "\n", 0L );
    for (i=indent; i>0; i--) os_file_printf( output, " ", 0L );
    thous = thousanths( ptr->stat.count, s->count );
    os_file_printf( output, "(", 0L );
    if (thous < 1000) os_file_printf( output, " ", 0L );
    if (thous < 100) os_file_printf( output, " ", 0L );
    os_file_printf( output, "%d", thous/10 );
    os_file_printf( output, ".%d", thous%10 );
    os_file_printf( output, " %s", (long)ptr->stat.name );
    os_file_printf( output, " %d", ptr->stat.count );
    stats_write_sub_parts( output, &ptr->stat, indent+12 );
    os_file_printf( output, ")", 0L );
    ptr = ptr->next;
  }
}


void stats_write_categories( output, ptr )
OS_FILE output;
STAT_LIST_PTR ptr;
{ while (ptr != NULL)
  { os_file_printf( output, "(%s", (long)ptr->stat.name );
    os_file_printf( output, " %d", ptr->stat.count );
    stats_write_sub_parts( output, &ptr->stat, 2L );
    os_file_printf( output, ")\n\n", 0L );
    ptr = ptr->next;
  }
}


void stats_write( output )
OS_FILE output;
{ char *mark = local_mark();
  os_file_printf( output, "( ; *** PROCESSOR %d ***\n\n", SCM_obj_to_int(processor->id) );
  stats_compute();
  sort_sub_parts( &stat_root );
  stats_write_categories( output, stat_root.sub_parts );
  os_file_printf( output, ")\n\n", 0L );
  local_release( mark );
}


void stats_generate()
{ OS_FILE output;
  long i;
  char *p;

  prog_filename = sstate->program_filename;
  p = prog_filename;
  while (*p != '\0') if (*p++ == '/') prog_filename = p;
    
  elog_setup( sstate->stats_start_time, sstate->stats_stop_time );

  output = os_file_open_output( string_append( prog_filename, ".stats" ) );
  if (output == -1)
  { os_warn( "Can't open statistics file\n", 0L ); os_quit(); }

  os_file_printf( output, "(\n\n", 0L );

  for (i=0; i<SCM_obj_to_int(pstate->nb_processors); i++)
  { processor = pstate->ps[i];
    stats_write( output );
  }

  os_file_printf( output, ")\n", 0L );

  os_file_close( output );

  elog_generate();
}


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


void stats_start1( id )
long id;
{ long i;

  if (sstate->profiling)
  { short *p = (short *)pstate->prof_bot;
    os_profil( (short *)NULL, 0L, 0L, 0L );
    while (p < (short *)pstate->prof_top) *(p++) = 0;
  }

  for (i=0; i<MAX_NB_STATS; i++) pstate->stats_counters[i] = 0;

  if (SCM_obj_to_int(pstate->id) == 0) sstate->stats_on = 1;

  if (sstate->profiling)
  { os_cpu_times( pstate->stats_cpu_times );
    os_profil( pstate->prof_bot,
               (long)(pstate->prof_top - pstate->prof_bot),
               (long)sstate->const_bot,
               (long)PROF_SHIFT );
  }

  pstate->elog_ptr = pstate->elog_top;

  if (id == SCM_obj_to_int(pstate->id))
  { pstate->elog_top[0] = EVENT(EVENT_WORKING,0);
    pstate->elog_top[1] = EVENT(EVENT_WORKING,0);
  }
  else
  { pstate->elog_top[0] = EVENT(EVENT_IDLE,0);
    pstate->elog_top[1] = EVENT(EVENT_IDLE,0);
  }
}


void stats_start2()
{ long start;
  start = os_real_time_clock();
  sstate->stats_start_time = start;
  while (os_clock_to_msec(sstate->stats_start_time - start) < 100)
    sstate->stats_start_time = os_real_time_clock(); /* wait for 100 msec */
}


long stats_stop1()
{ sstate->stats_stop_time = os_real_time_clock();
  if (sstate->profiling)
  { os_profil( (short *)NULL, 0L, 0L, 0L );
    os_cpu_times( pstate->cpu_times );
  }

  return os_clock_to_msec( sstate->stats_stop_time - sstate->stats_start_time );
}


void stats_stop2()
{ if ((SCM_obj_to_int(pstate->id) == 0) && sstate->stats_on)
  { sstate->stats_on = 0;
    if ((!sstate->profiling) && (sstate->nb_stats == NB_PREDEFINED_STATS))
    { long i, j;
      for (i=SCM_obj_to_int(pstate->nb_processors)-1; i>=0; i--)
      { if (pstate->ps[i]->elog_ptr != pstate->ps[i]->elog_top) goto stats_gen;
        for (j=sstate->nb_stats-1; j>=FIRST_AUTO_STAT; j--)
          if (pstate->ps[i]->stats_counters[j] != 0) goto stats_gen;
      }
      return;
      stats_gen: ;
    }
    stats_generate();
  }
}


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