/*
 * Primitives needed to implement the Haskell 98 Time & CPUTime modules.
 *
 * This file has to be included by builtin.c, and won't compile on its own.
 */
 

/* --------------------------------------------------------------------------
 * Time/CPUTime control:
 * ------------------------------------------------------------------------*/

static Void timeControl Args((Int));

static Void timeControl(what)
Int what; {
}

/* --------------------------------------------------------------------------
 * Time/CPUTime primitive table:
 * ------------------------------------------------------------------------*/

PROTO_PRIM(primClockTicks);
PROTO_PRIM(primGetCPUUsage);

PROTO_PRIM(primGetClockTime);
PROTO_PRIM(primGetCalTime);
PROTO_PRIM(primMkTime);

static struct primitive timePrimTable[] = {
  /* CPUTime primitives */
  {"clockTicks",           0, primClockTicks},
  {"getCPUUsage",          0+IOArity, primGetCPUUsage},
  /* Time primitives */
  {"getClockTimePrim",     0+IOArity, primGetClockTime},        
  {"toCalTimePrim",        2+IOArity, primGetCalTime},        
  {"toClockTimePrim",      7+IOArity, primMkTime},
  {0,			0, 0}
};

static struct primInfo timePrims = { timeControl, timePrimTable, 0 };

/* --------------------------------------------------------------------------
 * Time primitives:
 * ------------------------------------------------------------------------*/

primFun(primGetClockTime) { /* :: IO (Int,Int) */

#if HAVE_GETTIMEOFDAY
  struct timeval tv;
  int rc;
  
  rc = gettimeofday(&tv,NULL);
  
  if (rc == -1)
    throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL);
  IOReturn(ap(ap(mkTuple(2), mkInt(tv.tv_sec)),mkInt(tv.tv_usec)));
#elif HAVE_FTIME
  struct timeb tb;
  int rc = 0;
  
  rc = ftime(&tb);
  if (rc == -1)
    throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL);

  IOReturn(ap(ap(mkTuple(2),mkInt(tb.time)),mkInt(tb.millitm * 1000)));
#elif HAVE_TIME
  time_t t = time(NULL);
  if (t == (time_t)-1)
    throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL); 
  IOReturn(ap(ap(mkTuple(2),mkInt(t)),mkInt(0)));
#else
  IOFail(mkIOError(NULL,
		   nameIllegal,
		   "Time.getClockTime",
		   "operation not supported",
		   NULL));
#endif
}

#if HAVE_DECL__TIMEZONE
# define timezone _timezone
#endif


primFun(primGetCalTime) { /* Int   -> Int -> IO (.....) */
                          /* isUTC    secs */
                          /* isUTC => convert time to UTC, o/wise local time */

  Int isUTC;
#if HAVE_LOCALTIME && HAVE_GMTIME
  time_t secs;
  struct tm* tm;
  char* zoneNm = NULL;
  Int utcOff;
  Cell zoneStr = NIL;

  IntArg(isUTC,2+IOArity);
  IntArg(secs,1+IOArity);
  
  if (isUTC) {
    tm=gmtime(&secs);
  } else {
    tm=localtime(&secs);
  }
  
  /* Warning - ugliness. */
#if HAVE_STRUCT_TM_TM_ZONE
  zoneNm = (char*)tm->tm_zone;
#elif HAVE_TZNAME 
  zoneNm = (char*)(tm->tm_isdst ? tzname[1] : tzname[0]);
#else
  /* Don't know how to get at the timezone name, complain louder? */
  zoneNm = NULL;
#endif

#if HAVE_STRUCT_TM_TM_ZONE
  utcOff = tm->tm_gmtoff;
#elif HAVE_DECL_TIMEZONE || HAVE_DECL__TIMEZONE
# if HAVE_DECL_ALTZONE
  utcOff = (-(tm->tm_isdst ? altzone : timezone));
# else
  /* Assume DST adjustment is 1 hour. */
  utcOff = -(tm->tm_isdst ? (timezone - 3600) : timezone);
# endif
#else
  /* Again, complain louder? */
  utcOff = 0;
#endif

  pushString(zoneNm);
  zoneStr = pop();

  IOReturn(ap(ap(ap(ap(ap(ap(ap(ap(ap(ap(ap(mkTuple(11),mkInt(tm->tm_sec)),
					 mkInt(tm->tm_min)),
				      mkInt(tm->tm_hour)),
				   mkInt(tm->tm_mday)),
				mkInt(tm->tm_mon)),
			     mkInt(tm->tm_year)),
			  mkInt(tm->tm_wday)),
		       mkInt(tm->tm_yday)),
		    mkInt(tm->tm_isdst)),
		 zoneStr),
	      mkInt(utcOff)));
#else /* !(HAVE_LOCALTIME && HAVE_GMTIME) */

  IntArg(isUTC,2+IOArity);

  IOFail(mkIOError(NULL,
		   nameIllegal,
		   (isUTC ? "Time.toUTCTime" : "Time.toCalendarTime"),
		   "operation not supported",
		   NULL));
#endif

}

primFun(primMkTime) { /* Int{-year-}  -> Int{-month-} -> Int{-day-} ->
                         Int{-hour-}  -> Int{-mins-}  -> Int{-sec-} ->
			 Int{-tz offset-} -> IO Int{-secs since Epoch-} */
#if HAVE_MKTIME
  Int year, month, day;
  Int hour,min,sec;
  Int tz;

  struct tm tm;
  time_t t;
  
  IntArg(year,7+IOArity);
  IntArg(month,6+IOArity);
  IntArg(day,5+IOArity);
  IntArg(hour,4+IOArity);
  IntArg(min,3+IOArity);
  IntArg(sec,2+IOArity);
  IntArg(tz,1+IOArity);
  
  tm.tm_year = year;
  tm.tm_mon  = month;
  tm.tm_mday = day;
  tm.tm_hour = hour;
  tm.tm_min  = min;
  tm.tm_sec  = sec;
  /* The OpenGroup spec suggests that setting tm_isdst to a neg. value,
     makes mktime() try to figure this out on its own. */
  tm.tm_isdst = -1;
  
  t = mktime(&tm);
  
  if (t ==(time_t)-1)
    throwErrno("Time.toClockTime", TRUE, NO_HANDLE, NULL);

  /* mktime() assumes that the given time was local, but we might have
     been passed an UTC cal. time, so we now have to add the UTC
     offset, that is, the difference between toClockTime's UTC offset and
     the UTC offset returned by mktime().
  */
  tz = -tz;
#if HAVE_STRUCT_TM_TM_ZONE
  tz += tm.tm_gmtoff;
#elif HAVE_DECL_TIMEZONE || HAVE_DECL__TIMEZONE
# if HAVE_DECL_ALTZONE
  tz += (-(tm.tm_isdst ? altzone : timezone));
# else
  /* Assume DST adjustment is 1 hour */
  tz += (- (tm.tm_isdst ? (timezone - 3600) : timezone));
# endif
#else
  /* Unknown, assume nothing */
#endif
  
  IOReturn(mkInt(t+tz));
#else /* !HAVE_MKTIME */
  IOFail(mkIOError(NULL,
		   nameIllegal,
		   "Time.toClockTime",
		   "operation not supported",
		   NULL));
#endif
}

/* --------------------------------------------------------------------------
 * CPUTime primitives:
 * ------------------------------------------------------------------------*/

#ifdef CLK_TCK
CAFInt(primClockTicks, CLK_TCK)
#elif defined(CLOCKS_PER_SEC)
CAFInt(primClockTicks, CLOCKS_PER_SEC)
#else
CAFInt(primClockTicks, sysconf(_SC_CLK_TCK))
#endif

/* 
 * The code for grabbing the process times has been lifted from GHC.
 * Don't feel too bad about that, since I wrote and maintained it. 
 */
primFun(primGetCPUUsage) { /* IO (Int,Int,Int,Int) */
  int userSec, userNSec;
  int sysSec,  sysNSec;
#if HAVE_GETRUSAGE /* && ! irix_HOST_OS && ! solaris2_HOST_OS */
    struct rusage t;

    getrusage(RUSAGE_SELF, &t);
    userSec  = t.ru_utime.tv_sec;
    userNSec = 1000 * t.ru_utime.tv_usec;
    sysSec   = t.ru_stime.tv_sec;
    sysNSec  = 1000 * t.ru_stime.tv_usec;

#elif HAVE_TIMES
    struct tms t;
# if defined(CLK_TCK)
#  define ticks CLK_TCK
# else
    long ticks;
    ticks = sysconf(_SC_CLK_TCK);
# endif

    times(&t);
    userSec  = t.tms_utime / ticks;
    userNSec = (t.tms_utime - userSec * ticks) * (1000000000 / ticks);
    sysSec   = t.tms_stime / ticks;
    sysNSec  = (t.tms_stime - sysSec * ticks) * (1000000000 / ticks);

#else
    IOFail(mkIOError(NULL,
		     nameIllegal,
		     "CPUTime.getCPUTime",
		     "illegal operation",
		     NULL));
#endif
    IOReturn(ap(ap(ap(ap( mkTuple(4), mkInt(userSec)),
		      mkInt(userNSec)),
		   mkInt(sysSec)),
		mkInt(sysNSec)));
}

