/* FILE: evoc.cc                   -*-Mode: c++-*-
 *
 * Stuff that should be moved eventually into the oc extension.
 *
 * NOTICE: Please see the file ../../LICENSE
 *
 * Last modified on: $Date: 2002/11/18 19:44:17 $
 * Last modified by: $Author: donahue $
 */

#include "evoc.h"
#include "errhandlers.h"

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

#if (SYSTEM_TYPE == UNIX)
#include <sys/time.h>  // Some of these may be OS dependent...
#include <sys/times.h>
#endif // SYSTEM_TYPE

#include <time.h>

/* End includes */     

int Verbosity=10; // Default value for Verbosity

ClassDoc::ClassDoc(const CHAR *new_classname,const CHAR *new_maintainer,
		   const CHAR *new_revision,const CHAR *new_revdate)
{
  classname  = new_classname;
  maintainer = new_maintainer;
  revision   = new_revision;
  revdate    = new_revdate;
}

//////////////////////////////////////////////////////////////////////////
//////////////////////////// Tcl/Tk Interface ////////////////////////////
//////////////////////////////////////////////////////////////////////////

// C-pointer <--> ascii string conversion class.
//   Currently this routine maps things through %lx, but this
// may change in the future to use a hash table.  (I'm assuming
// that void * can be converted to an unsigned long without
// loss of data.  There is a check on this in PtrToAscii for safety.)

const ClassDoc Omf_AsciiPtr::class_doc("Omf_AsciiPtr",
	      "Michael J. Donahue (michael.donahue@nist.gov)",
	      "1.0.0","19-Sep-1997");

const size_t Omf_AsciiPtr::ascii_string_width(2*sizeof(unsigned long)+8);
/// Each byte goes to 2 hex digits (hence 2*), +1 for the trailing
/// null, +2 in case a "0x" is prepended, +5 for safety.

void Omf_AsciiPtr::PtrToAscii(const void* ptr,char* buf)
{
#define MEMBERNAME "PtrToAscii(const void* ptr,char* buf)"
  sprintf(buf,"%lx",(unsigned long)(ptr));
  if(strlen(buf)+1>GetAsciiSize()) {
    FatalError(-1,STDDOC,"Buffer overflow; "
	       "Omf_AsciiPtr::ascii_string_width too small");
  }

  // Check readback
  if(AsciiToPtr(buf)!=ptr) {
    FatalError(-1,STDDOC,"Ptr -> %%lx -> ptr conversion error");
  }

  return;
#undef MEMBERNAME
}

void* Omf_AsciiPtr::AsciiToPtr(const char* buf)
{ // NOTE: ONLY strings produced by Omf_AsciiPtr::PtrToAscii
  //  should ever be sent to this routine.
#define MEMBERNAME "AsciiToPtr(const char* buf,void* &ptr)"
  unsigned long temp;
  sscanf(buf,"%lx",&temp);
  return (void *)temp;
#undef MEMBERNAME
}

//////////////////////////////////////////////////////////////////////////
//////////////////////////// UTILITY ROUTINES ////////////////////////////
//////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////
// Random number generator routines.  Oc_UnifRand() random value in
// [0,1] with unif. distrib.  The random number generator may be
// (re)initialized by calling Oc_Srand() or Oc_Srand(seed).  In the
// first case the seed is determined by sampling the system clock.
void Oc_Srand(unsigned int seed)
{
  const int exercise=100;
  OMF_SRANDOM(seed+1); // On linux systems (others?), srandom(0) and
  /// srandom(1) generate the same sequence.  This is a) dumb, and
  /// b) isn't documented in the man pages.  Since 0 and 1 are likely
  /// to be common requests, work around this unexpected behavior by
  /// bumping all seeds up one.  BTW, on linux systems, srand/rand
  /// are the same as srandom/random.
  for(int i=0;i<exercise;i++) {
    OMF_RANDOM();  // "Exercise" generator, to keep it fit and trim.
  }
}

void Oc_Srand()
{
  unsigned int seed=0;
  Tcl_Interp* interp=Oc_GlobalInterpreter();
  if(interp==NULL) seed=42;  // No interpreter available
  else {
    Tcl_SavedResult saved;
    Tcl_SaveResult(interp, &saved);
    // Use Tcl 'clock clicks' command to get a seed
    Tcl_Eval(interp,Oc_AutoBuf("clock clicks"));
    seed=(unsigned int)atol(Tcl_GetStringResult(interp));
    Tcl_RestoreResult(interp, &saved);
  }
  Oc_Srand(seed);
}

double Oc_UnifRand()
{ // Returns random value in [0,1] with unif. distrib.
  return ((double)OMF_RANDOM())/((double)OMF_RANDOM_MAX);
}

// Tcl wrappers for Oc_Srand and Oc_UnifRand
int OcSrand(ClientData,Tcl_Interp *interp,int argc,CONST84 char** argv)
{
  char buf[256];
  Tcl_ResetResult(interp);
  if(argc>2) {
    Oc_Snprintf(buf,sizeof(buf),
		"wrong # args: should be \"%.100s ?arg?\"",argv[0]);
    Tcl_AppendResult(interp,buf,(char *)NULL);
    return TCL_ERROR;
  }

  if(argc<2) {
    Oc_Srand(); // Use clock-based seed
  } else {
    char* endptr;
    unsigned long int ulseed = strtoul(argv[1],&endptr,10);
    if(argv[1][0]=='\0' || *endptr!='\0') {
      // argv[1] is not an integer
      Oc_Snprintf(buf,sizeof(buf),
		  "bad seed \"%.100s\": must be integer",argv[1]);
      Tcl_AppendResult(interp,buf,(char *)NULL);
      return TCL_ERROR;
    }
    Oc_Srand(static_cast<unsigned int>(ulseed));
  }

  return TCL_OK;
}

int OcUnifRand(ClientData,Tcl_Interp *interp,int argc,CONST84 char** argv)
{
  static char buf[256];
  Tcl_ResetResult(interp);
  if(argc!=1) {
    Oc_Snprintf(buf,sizeof(buf),
		"wrong # args: should be \"%.100s\"",argv[0]);
    Tcl_AppendResult(interp,buf,(char *)NULL);
    return TCL_ERROR;
  }
  Oc_Snprintf(buf,sizeof(buf),"%.17g",Oc_UnifRand());
  Tcl_AppendResult(interp,buf,(char *)NULL);

  return TCL_OK;
}

#if (TCL_MAJOR_VERSION == 7)
// Tcl_MathProc wrappers for Oc_Srand and Oc_UnifRand.  These
// are to provide srand() and rand() functions to the Tcl
// expr command in Tcl 7.x.
int OcSrandTclMathProc(ClientData,Tcl_Interp*,
		       Tcl_Value* args,Tcl_Value* resultPtr)
{
  if(args[0].type != TCL_INT) return TCL_ERROR; // Safety
  Oc_Srand(static_cast<unsigned int>(args[0].intValue));
  resultPtr->type = TCL_DOUBLE;
  resultPtr->doubleValue = Oc_UnifRand();
  return TCL_OK;
}

int OcUnifRandTclMathProc(ClientData,Tcl_Interp*,
			  Tcl_Value*,Tcl_Value* resultPtr)
{
  resultPtr->type = TCL_DOUBLE;
  resultPtr->doubleValue = Oc_UnifRand();
  return TCL_OK;
}
#endif // TCL_MAJOR_VERSION == 7

#if (TCL_MAJOR_VERSION == 7)
void Oc_AddTclExprExtensions(Tcl_Interp* interp) {
  // If Tcl 7.x, add rand() and srand() functions to expr.
  // Note: Tcl_CreateMathFunc copies the contents of the argTypes
  //  array into an internal structure, so argTypes may be freed
  //  afterwards.  This is not actually documented, but is expected,
  //  and moreover is the way it is done in the Tcl 7.5 and 7.6
  //  code base, which is all we care about.
  Tcl_ValueType OcSrandTclMathProcArgTypes[1] = { TCL_INT };
  Tcl_CreateMathFunc(interp,Oc_AutoBuf("srand"),1,
		     OcSrandTclMathProcArgTypes,
		     (Tcl_MathProc *)OcSrandTclMathProc,
		     (ClientData)NULL);
  Tcl_CreateMathFunc(interp,Oc_AutoBuf("rand"),0,NULL,
		     (Tcl_MathProc *)OcUnifRandTclMathProc,
		     (ClientData)NULL);
}
#else
void Oc_AddTclExprExtensions(Tcl_Interp*) {}
#endif // TCL_MAJOR_VERSION == 7

int OcAddTclExprExtensions(ClientData,Tcl_Interp *interp,
			   int argc,CONST84 char** argv)
{
  static char buf[4096];
  Tcl_ResetResult(interp);
  if(argc>2) {
    Oc_Snprintf(buf,sizeof(buf),
		"wrong # args: should be \"%.100s\" ?interp?",argv[0]);
    Tcl_AppendResult(interp,buf,(char *)NULL);
    return TCL_ERROR;
  }
  if(argc==1) {
    // Add extensions to current interpreter
    Oc_AddTclExprExtensions(interp);
  } else {
    // Add extensions to child interpreter
    Tcl_Interp* slave = Tcl_GetSlave(interp,argv[1]);
    if(slave==NULL) {
      Oc_Snprintf(buf,sizeof(buf),"No slave interpreter named \"%.256s\"",
		  argv[1]);
      Tcl_AppendResult(interp,buf,(char *)NULL);
      return TCL_ERROR;
    }
    Oc_AddTclExprExtensions(slave);
  }
  return TCL_OK;
}



//////////////////////////////////////////////////////////////////////////
// Oc_TimeVal class

const ClassDoc Oc_TimeVal::class_doc("Oc_TimeVal",
	      "Michael J. Donahue (michael.donahue@nist.gov)",
	      "1.0.0","May-1998");

void Oc_TimeVal::Print(FILE* fptr)
{ // For debugging
  fprintf(fptr," ticks_per_second=%lu\n",ticks_per_second);
  fprintf(fptr,"        max_ticks=%lu\n",max_ticks);
  fprintf(fptr,"            ticks=%lu\n",ticks);
  fprintf(fptr,"         overflow=%lu\n",overflow);
  fflush(fptr);
}

BOOL Oc_TimeVal::IsValid() const
{
  if(ticks>max_ticks) return 0;
  return 1;
}

BOOL AreCompatible(const Oc_TimeVal& time1,const Oc_TimeVal& time2)
{
  if(time1.ticks_per_second==time2.ticks_per_second &&
     time1.max_ticks==time2.max_ticks) return 1;
  return 0;
}

void Oc_TimeVal::Reset()
{
  ticks=0;
  overflow=0;
}

void Oc_TimeVal::Reset(unsigned long _ticks_per_second,
		       unsigned long _max_ticks)
{
  ticks_per_second=_ticks_per_second;
  max_ticks=_max_ticks;
  Reset();
}

Oc_TimeVal::Oc_TimeVal()
{
  Reset(1,(unsigned long)-1);
}

Oc_TimeVal::Oc_TimeVal(const Oc_TimeVal &time)
{
  Reset(time.ticks_per_second,time.max_ticks);
  ticks=time.ticks;
  overflow=time.overflow;
}

Oc_TimeVal::Oc_TimeVal(unsigned long _ticks_per_second,
		       unsigned long _max_ticks)
{
  Reset(_ticks_per_second,_max_ticks);
}

void Oc_TimeVal::SetTicks(unsigned long _ticks)
{
#define MEMBERNAME "SetTicks"
  if(_ticks>max_ticks)
    FatalError(-1,STDDOC,"Import _ticks bigger than max_ticks");
  ticks=_ticks;
#undef MEMBERNAME
}

Oc_TimeVal::operator double() const
{ // Returns time in seconds, in floating point.
  // Guard carefully against overflow on integer types
  double bigticks=double(overflow)*(double(max_ticks)+1.0);
  double smallticks=double(ticks);
  return (bigticks+smallticks)/double(ticks_per_second);
}

Oc_TimeVal& Oc_TimeVal::operator=(const Oc_TimeVal& time)
{
  Reset(time.ticks_per_second,time.max_ticks);
  ticks=time.ticks;
  overflow=time.overflow;
  return *this;
}

Oc_TimeVal& Oc_TimeVal::operator+=(const Oc_TimeVal& time)
{
#define MEMBERNAME "operator+="
  // Insure times use compatible bases
  if(!AreCompatible(*this,time))
    FatalError(-1,STDDOC,"Attempt to add incompatible Oc_TimeVal's\n"
	       "  *this is (%lu,%lu), time is (%lu,%lu)",
	       ticks_per_second,max_ticks,
	       time.ticks_per_second,time.max_ticks);
  overflow+=time.overflow;
  if( max_ticks-time.ticks >= ticks )
    ticks+=time.ticks;
  else {
    overflow++;
    ticks=(ticks-(max_ticks-time.ticks))+1;
    /// Grouped to protect against overflow
  }
  return *this;
#undef MEMBERNAME
}

Oc_TimeVal& Oc_TimeVal::operator-=(const Oc_TimeVal& time)
{ // NOTE: Truncates to zero if time>*this.
#define MEMBERNAME "operator-="
  // Insure times use compatible bases
  if(!AreCompatible(*this,time))
    FatalError(-1,STDDOC,"Attempt to subtract incompatible Oc_TimeVal's");
  if(overflow<time.overflow) {
    Reset();
  } else {
    overflow-=time.overflow;
    if(ticks>=time.ticks) {
      ticks-=time.ticks;
    } else {
      if(overflow<1) Reset();
      else {
	overflow--;
	ticks=((max_ticks-time.ticks)+time.ticks)+1;
	/// Grouped to protect against overflow
      }
    }
  }
  return *this;
#undef MEMBERNAME
}


Oc_TimeVal operator+(const Oc_TimeVal& time1,const Oc_TimeVal& time2)
{ // This routine assumes time1 and time2 are valid.

  // Insure times use compatible bases
  if(!AreCompatible(time1,time2))
    PlainError(1,"Attempt to add incompatible Oc_TimeVal's");

  Oc_TimeVal time3(time1);
  time3.overflow+=time2.overflow;
  if( time3.max_ticks-time2.ticks >= time3.ticks)
    time3.ticks+=time2.ticks;
  else {
    time3.overflow++;
    time3.ticks=(time3.ticks-(time3.max_ticks-time2.ticks))+1;
    /// Grouped to protect against overflow
  }

  return time3;
}

Oc_TimeVal operator-(const Oc_TimeVal& time1,const Oc_TimeVal& time2)
{ // This routine assumes time1 and time2 are valid.
  // If time1<time2, then returns zero time.

  // Insure times use compatible bases
  if(!AreCompatible(time1,time2))
    PlainError(1,"Attempt to subtract incompatible Oc_TimeVal's");

  Oc_TimeVal zero(time1);
  zero.ticks=0; zero.overflow=0;

  Oc_TimeVal time3(time1);
  if(time3.overflow<time2.overflow) return zero;
  time3.overflow-=time2.overflow;
  
  if(time3.ticks>=time2.ticks)
    time3.ticks-=time2.ticks;
  else {
    if(time3.overflow<1) return zero;
    time3.overflow--;
    time3.ticks=((time3.max_ticks-time2.ticks)+time3.ticks)+1;
    /// Grouped to protect against overflow
  }

  return time3;
}

//////////////////////////////////////////////////////////////////////////
// Oc_Times function
//   System independent replacement for the Unix times(2)
// function. Returns the cpu and elapsed times for the current
// process, relative to the first time this routine is called.  If
// this routine is called early in the process initialization, then
// the returned times will be effectively process times.
//   Resolution is system dependent.  This routine tries to correct for
// counter overflow and wrap-around by keeping track of the system
// tick count from the last call, and if the new return value is
// smaller than the last then a wrap-around of 1 period is assumed.
// This will not work properly if the time between calls to this
// function is larger than the wrap-around period.  For an 4-byte wide
// clock_t with CLOCKS_PER_SEC at 1024, the time to overflow is
// about 48.5 days (Windows NT).  With CLOCKS_PER_SEC at 1000000
// overflow time is just over 71 minutes (Linux/x86).  OTOH, an 8-byte
// wide clock_t with a nanosecond tick rate takes over 584 years to
// overflow.  NOTE 1: Even though CLOCKS_PER_SEC is 1e6 on
// Linux/x86, the granularity of all user-accessible clocks appears to
// be only 1/100 seconds (=1/CLK_TCK).  On Linux/AXP, CLK_TCK is 1000
// (and clock_t is 8 bytes wide). NOTE 2: The wrap around periods are
// generally determined as clock_t(-1).  This ASSUMES clock_t is an
// unsigned type (and 2's complement integer arithmetic).  We should
// probably put a check for this in varinfo.cc/ocport.h.
//   If suitable system timing call(s) can't be determined, then this
// routine will return 0('s).
//
// For Unix platforms, use the following macros:
//   HAS_TIMES
//   HAS_CLOCK
//   HAS_GETTIMEOFDAY
// If HAS_TIMES is defined, then Oc_Times will use the system times()
// command.  Otherwise, if HAS_CLOCK is defined, then clock() will be
// used to determine the cpu time; if HAS_GETTIMEOFDAY is defined, then
// gettimeofday() will be used to set the wall (elapsed) time.
// On Windows platforms, clock() and GetTickCount() are used.
// Alternately, define
//   NO_CLOCKS
// to have these routines always return 0.  This always overrides the
// other macros.

///// TEMPORARY MACROS, TO BE FIXED UP BY DGP ////////////////////
#if !defined(NO_CLOCKS) && (SYSTEM_TYPE != WINDOWS)
#  ifndef CLK_TCK
#    ifdef _SC_CLK_TCK
       static const long CLK_TCK = sysconf(_SC_CLK_TCK);
#    elif defined(HZ)
#      define CLK_TCK HZ
#    endif
#  endif
#  ifdef CLK_TCK
#    define HAS_TIMES
#  endif
#  ifdef CLOCKS_PER_SEC
#    define HAS_CLOCK
#  endif
#  define HAS_GETTIMEOFDAY
#endif
//////////////////////////////////////////////////////////////////

#ifdef NO_CLOCKS
void Oc_Times(Oc_TimeVal& cpu_time,Oc_TimeVal& wall_time)
{
  cpu_time.Reset();  wall_time.Reset();  // Return zeros
}
#else // NO_CLOCKS
void Oc_Times(Oc_TimeVal& cpu_time,Oc_TimeVal& wall_time)
{
  static BOOL first_time=1;
#if (SYSTEM_TYPE == WINDOWS)
  // Use clock() to get cpu time, GetTickCount() to get wall time.
  // GetTickCount() is in the Windows API; it returns number of ms
  // since Windows was started
  static Oc_TimeVal cpu_accum(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_last(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_now(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_accum(1000,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_last(1000,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_now(1000,(unsigned long)clock_t(-1));
  cpu_now.ticks=clock();
  wall_now.ticks=GetTickCount();
  cpu_now.overflow=cpu_last.overflow;
  if(cpu_now.ticks<cpu_last.ticks) cpu_now.overflow++;
  wall_now.overflow=wall_last.overflow;
  if(wall_now.ticks<wall_last.ticks) wall_now.overflow++;
#elif defined(HAS_TIMES) // SYSTEM_TYPE == WINDOWS
  // Use the Unix times(2) call
  static Oc_TimeVal cpu_accum(CLK_TCK,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_last(CLK_TCK,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_now(CLK_TCK,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_accum(CLK_TCK,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_last(CLK_TCK,(unsigned long)clock_t(-1));
  static Oc_TimeVal wall_now(CLK_TCK,(unsigned long)clock_t(-1));
  static struct tms buf;
  wall_now.ticks = (unsigned long)times(&buf);
  wall_now.overflow=wall_last.overflow;
  if(wall_now.ticks<wall_last.ticks) wall_now.overflow++;
  cpu_now.ticks=(unsigned long)(buf.tms_utime+buf.tms_stime);
  cpu_now.overflow=cpu_last.overflow;
  if(cpu_now.ticks<cpu_last.ticks) cpu_now.overflow++;
#else // ...SYSTEM_TYPE == WINDOWS
  // Use clock() and gettimeofday(), as available.

# ifdef HAS_CLOCK
  static Oc_TimeVal cpu_accum(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_last(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  static Oc_TimeVal cpu_now(CLOCKS_PER_SEC,(unsigned long)clock_t(-1));
  cpu_now.ticks=clock();
  cpu_now.overflow=cpu_last.overflow;
  if(cpu_now.ticks<cpu_last.ticks) cpu_now.overflow++;
# else // !HAS_CLOCK
  static Oc_TimeVal cpu_accum,cpu_last,cpu_now;
# endif // HAS_CLOCK

# ifdef HAS_GETTIMEOFDAY
  // Store microseconds in .tick, seconds in .overflow
  static Oc_TimeVal wall_accum(1000000,999999);
  static Oc_TimeVal wall_last(1000000,999999);
  static Oc_TimeVal wall_now(1000000,999999);
  static struct timeval tv;
  gettimeofday(&tv,NULL);
  wall_now.overflow=tv.tv_sec;  // Seconds
  wall_now.ticks=tv.tv_usec;    // Microseconds
# else // !HAS_GETTIMEOFDAY
  static Oc_TimeVal wall_accum,wall_last,wall_now;
# endif // HAS_GETTIMEOFDAY

#endif // ...SYSTEM_TYPE == WINDOWS
  if(!first_time) {
    cpu_accum+=(cpu_now-cpu_last);
    wall_accum+=(wall_now-wall_last);
  } else {
    first_time=0;
  }
  cpu_last=cpu_now;     wall_last=wall_now;
  cpu_time=cpu_accum;   wall_time=wall_accum;
}
#endif // NO_CLOCKS

// Tcl wrapper for Oc_Times
int OcTimes(ClientData,Tcl_Interp *interp,int argc,CONST84 char** argv)
{
  static char buf[256];
  Tcl_ResetResult(interp);
  if(argc!=1) {
    Oc_Snprintf(buf,sizeof(buf),
		"wrong # args: should be \"%.100s\"",argv[0]);
    Tcl_AppendResult(interp,buf,(char *)NULL);
    return TCL_ERROR;
  }

  Oc_TimeVal cpu_time,wall_time;
  Oc_Times(cpu_time,wall_time);

  Oc_Snprintf(buf,sizeof(buf),"%.17g %.17g",
	      double(cpu_time),double(wall_time));
  Tcl_AppendResult(interp,buf,(char *)NULL);

  return TCL_OK;
}