path: root/time.c

/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program 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 the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 */

/* "time.c" functions dealing with time.
   Author: Aubrey Jaffer */

#include "scm.h"

#ifdef STDC_HEADERS
# include <time.h>
# ifdef M_SYSV
#  include <sys/types.h>
#  include <sys/times.h>
# endif
# ifdef sun
#  include <sys/types.h>
#  include <sys/times.h>
# endif
# ifdef ultrix
#  include <sys/types.h>
#  include <sys/times.h>
# endif
# ifdef nosve
#  include <sys/types.h>
#  include <sys/times.h>
# endif
# ifdef _UNICOS
#  include <sys/types.h>
#  include <sys/times.h>
# endif
# ifdef __IBMC__
#  include <sys/timeb.h>
# endif
#else
# ifdef SVR2
#  include <time.h>
# else
#  ifndef ARM_ULIB
#   include <sys/time.h>
#  else
#   include <time.h>
#  endif
# endif
# include <sys/types.h>

# ifndef ARM_ULIB
#  include <sys/times.h>
# else
#  include <time.h>
# endif

#endif

/* Define this if your system lacks ftime(). */
/* #define LACK_FTIME */
/* Define this if your system has gettimeofday()
   (LACK_FTIME should not be defined). */
/* #define USE_GETTIMEOFDAY */
/* Define this if your system lacks times(). */
/* #define LACK_TIMES */

#ifdef linux
# include <sys/types.h>
# include <sys/time.h>
# include <sys/timeb.h>
# define USE_GETTIMEOFDAY
#endif
#ifdef __FreeBSD__
# include <sys/types.h>
# include <sys/time.h>
# include <sys/timeb.h>
# define USE_GETTIMEOFDAY
#endif
#ifdef __TURBOC__
# define LACK_TIMES
#endif
#if (__TURBOC__==1) /* Needed for TURBOC V1.0 */
# define LACK_FTIME
# undef MSDOS
#endif
#ifdef __HIGHC__
# define LACK_TIMES
#endif
#ifdef macintosh
# define LACK_FTIME
# define LACK_TIMES
# define CLK_TCK 60
#endif
#ifdef SVR2
# define LACK_FTIME
#endif
#ifdef SVR4
# define LACK_FTIME
#endif
#ifdef __svr4__
# define LACK_FTIME
#endif
#ifdef nosve
# define LACK_FTIME
#endif
#ifdef GO32
# define LACK_FTIME
# define LACK_TIMES
#endif
#ifdef atarist
# define LACK_FTIME
# define LACK_TIMES
#endif
#ifdef ARM_ULIB
# define LACK_FTIME
# define LACK_TIMES
#endif
#ifdef _DCC
# define LACK_FTIME
#endif
#ifdef MSDOS
# ifndef GO32
#  include <sys/types.h>
#  include <sys/timeb.h>
# endif
#endif
#ifdef _UNICOS
# define LACK_FTIME
#endif
#ifdef __amigados__
# include <sys/time.h>
# include <sys/timeb.h>
# include <sys/times.h>
# define USE_GETTIMEOFDAY
#endif

#ifndef LACK_FTIME
# ifdef unix
#  ifndef GO32
#   include <sys/timeb.h>
#  endif
# endif
#endif

#ifdef __EMX__
# define LACK_TIMES
# include <sys/types.h>
# include <sys/timeb.h>
#endif

#ifdef MWC
# include <time.h>
# include <sys/timeb.h>
#endif

#ifdef ARM_ULIB
# include <sys/types.h>
# include <time.h>
#endif

#ifdef vms
# define LACK_TIMES
# define LACK_FTIME
#endif

#ifdef CLK_TCK
# define CLKTCK CLK_TCK
# ifdef CLOCKS_PER_SEC
#  ifdef unix
#   ifndef ARM_ULIB
#    include <sys/times.h>
#   endif
#   define LACK_CLOCK
    /* This is because clock() might be POSIX rather than ANSI.
       This occurs on HP-UX machines */
#  endif
# endif
#else
# ifdef CLOCKS_PER_SEC
#  define CLKTCK CLOCKS_PER_SEC
# else
#  define LACK_CLOCK
#  ifdef AMIGA
#   include <stddef.h>
#   define LACK_TIMES
#   define LACK_FTIME
#   define CLKTCK 1000
#  else
#   define CLKTCK 60
#  endif
# endif
#endif

#ifdef __STDC__
# define timet time_t
#else
# define timet long
#endif

#ifdef LACK_TIMES
# ifdef LACK_CLOCK
#  ifdef AMIGA
/* From: "Fred Bayer" <bayerf@lan.informatik.tu-muenchen.de> */
#   ifdef AZTEC_C		/* AZTEC_C */
#    include <devices/timer.h>
static long mytime()
{
	long sec, mic, mili = 0;
	struct timerequest *timermsg;
	struct MsgPort *timerport;
	if(!(timerport = (struct MsgPort *)CreatePort(0, 0))){
	lputs("No mem for port.\n", cur_errp);
		return mili;
	}
	if(!(timermsg = (struct timerequest *)
		 CreateExtIO(timerport, sizeof(struct timerequest)))){
		lputs("No mem for timerequest.\n", cur_errp);
		DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
	return mili;
	}
	if(!(OpenDevice(TIMERNAME, UNIT_MICROHZ, timermsg, 0))){
		timermsg->tr_node.io_Command = TR_GETSYSTIME;
		timermsg->tr_node.io_Flags = 0;
		DoIO(timermsg);
		sec = timermsg->tr_time.tv_secs;
		mic = timermsg->tr_time.tv_micro;
		mili = sec*1000+mic/1000;
		CloseDevice(timermsg);
	}
	else lputs("No Timer available.\n", cur_errp);
	DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
	DeleteExtIO(timermsg);
	return mili ;
}
#   else			/* this is for SAS/C */
static long mytime()
{
   unsigned int cl[2];
   timer(cl);
   return(cl[0]*1000+cl[1]/1000);
}
#   endif /* AZTEC_C */
#  else /* AMIGA */
#   define mytime() ((time((timet*)0) - your_base) * CLKTCK)
#  endif /* AMIGA */
# else /* LACK_CLOCK */
#  define mytime clock
# endif /* LACK_CLOCK */
#else /* LACK_TIMES */
static long mytime()
{
  struct tms time_buffer;
  times(&time_buffer);
  return time_buffer.tms_utime + time_buffer.tms_stime;
}
#endif /* LACK_TIMES */

#ifdef LACK_FTIME
# ifdef AMIGA
SCM your_time()
{
  return MAKINUM(mytime());
}
# else
timet your_base = 0;
SCM your_time()
{
	return MAKINUM((time((timet*)0) - your_base) * (int)CLKTCK);
}
# endif /* AMIGA */
#else /* LACK_FTIME */
# ifdef USE_GETTIMEOFDAY
int scm_ftime(time_buffer)
     struct timeb *time_buffer;
{
  struct timezone t_z; struct timeval t_v;
  if (gettimeofday(&t_v, &t_z) < 0) return -1;
  time_buffer->timezone = t_z.tz_minuteswest;
  time_buffer->dstflag = t_z.tz_dsttime;
  time_buffer->millitm = t_v.tv_usec / 1000;
  time_buffer->time = t_v.tv_sec;
  return 0;}
# else /* USE_GETTIMEOFDAY */
#  define scm_ftime ftime
# endif /* USE_GETTIMEOFDAY */
struct timeb your_base = {0};
# define TIMETRIES 10
SCM your_time()
{
  long tmp;
  struct timeb time_buffer1;
  struct timeb time_buffer2;
  int cnt = 0;
 tryagain:
  cnt++;
  scm_ftime(&time_buffer1);
  scm_ftime(&time_buffer2);
  if (time_buffer1.time==time_buffer2.time) {
    if (time_buffer1.millitm > time_buffer2.millitm)
      time_buffer2.time = time_buffer2.time + 1;
  }
  else if ((1 + time_buffer1.time)==time_buffer2.time) ;
  else if (cnt < TIMETRIES) goto tryagain;
  else {
    scm_warn("could not read two ftime()s within one second in 10 tries",0L);
    return MAKINUM(-1);
  }
  tmp = CLKTCK*(time_buffer2.millitm - your_base.millitm);
  tmp = CLKTCK*(time_buffer2.time - your_base.time) + tmp/1000;
  return MAKINUM(tmp);
}
#endif /* LACK_FTIME */

long my_base = 0;
SCM my_time()
{
  return MAKINUM(mytime()-my_base);
}

SCM curtime()
{
  timet timv = time((timet*)0);
  SCM ans;
#ifndef _DCC
# ifdef STDC_HEADERS
#  if (__TURBOC__ > 0x201)
  timv = mktime(gmtime(&timv));
#  endif
# endif
#endif
  ans = ulong2num(timv);
  return BOOL_F==ans ? MAKINUM(timv) : ans;
}

long time_in_msec(x)
     long x;
{
  if (CLKTCK==60) return (x*50)/3;
  else
    return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK);
}

static iproc subr0s[] = {
	{"get-internal-run-time", my_time},
	{"get-internal-real-time", your_time},
	{"current-time", curtime},
	{0, 0}};

void reset_time()
{
#ifdef LACK_FTIME
# ifndef AMIGA
	time(&your_base);
# endif
#else
	scm_ftime(&your_base);
#endif
	my_base = 0;
	my_base = mytime();
}
void init_time()
{
	sysintern("internal-time-units-per-second",
		  MAKINUM((long)CLKTCK));
	reset_time();
	init_iprocs(subr0s, tc7_subr_0);
}