yap-6.3/C/sysbits.c

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		sysbits.c						 *
* Last rev:	4/03/88							 *
* mods:									 *
* comments:	very much machine dependent routines			 *
*									 *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif

/*
 * In this routine we shall try to include the inevitably machine dependant
 * routines. These include, for the moment : Time, A rudimentar form of
 * signal handling, OS calls,
 *
 * Vitor Santos Costa, February 1987
 *
 */

#include "Yap.h"
#include "yapio.h"
#include "eval.h"
#include "Yatom.h"
#include "Heap.h"
#include "alloc.h"
#include "tracer.h"
#include <math.h>
#if STDC_HEADERS
#include <stdlib.h>
#endif
#if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER
#include <sys/time.h>
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_SYS_WAIT_H && !defined(__MINGW32__) && !_MSC_VER
#include <sys/wait.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y)
#endif
#if HAVE_GETPWNAM
#include <pwd.h>
#endif
#if HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef _WIN32
#define _WIN32_WINNT 0x0400
#include <windows.h>
/* required for DLL compatibility */
#if HAVE_DIRECT_H
#include <direct.h>
#endif
#include <io.h>
#else
#if HAVE_SYS_PARAM_H
#include <sys/param.h>
#endif
#endif

#ifdef __MINGW32__
#ifdef HAVE_ENVIRON
#undef HAVE_ENVIRON
#endif
#endif

STATIC_PROTO (void InitPageSize, (void));
STATIC_PROTO (void InitTime, (void));
STATIC_PROTO (void InitWTime, (void));
STATIC_PROTO (Int p_sh, (void));
STATIC_PROTO (Int p_shell, (void));
STATIC_PROTO (Int p_system, (void));
STATIC_PROTO (Int p_mv, (void));
STATIC_PROTO (Int p_cd, (void));
STATIC_PROTO (Int p_getcwd, (void));
STATIC_PROTO (Int p_dir_sp, (void));
STATIC_PROTO (Int p_getenv, (void));
STATIC_PROTO (Int p_environ, (void));
STATIC_PROTO (void InitRandom, (void));
STATIC_PROTO (Int p_srandom, (void));
STATIC_PROTO (Int p_alarm, (void));
#ifdef MACYAP
STATIC_PROTO (int chdir, (char *));
/* #define signal	skel_signal */
#endif /* MACYAP */

STD_PROTO (void exit, (int));

#ifdef _WIN32
static void
WinError(char *yap_error)
{
  char msg[256];
  /* Error, we could not read time */
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
		  NULL, GetLastError(), 
		  MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
		  NULL);
    Error(SYSTEM_ERROR, TermNil, "%s: %s", yap_error, msg);
}
#endif /* _WIN32 */


#define is_valid_env_char(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
			       (C) <= 'Z') || (C) == '_' )


int
dir_separator (int ch)
{
#ifdef MAC
  return (ch == ':');
#elif ATARI || _MSC_VER
  return (ch == '\\');
#elif defined(__MINGW32__)
  return (ch == '\\' || ch == '/');
#else
  return (ch == '/');
#endif
}

void
InitSysPath(void) {
  strncpy(FileNameBuf, LIB_DIR, YAP_FILENAME_MAX);
#ifdef MAC
  strncat(FileNameBuf,":", YAP_FILENAME_MAX);
#elif ATARI || _MSC_VER || defined(__MINGW32__)
  strncat(FileNameBuf,"\\", YAP_FILENAME_MAX);
#else
  strncat(FileNameBuf,"/", YAP_FILENAME_MAX);
#endif
  strncat(FileNameBuf, "library", YAP_FILENAME_MAX);
  PutValue(LookupAtom("system_library_directory"),
	   MkAtomTerm(LookupAtom(FileNameBuf)));
}

static Int
p_dir_sp (void)
{
#ifdef MAC
  Term t = MkIntTerm(':');
#elif ATARI || _MSC_VER || defined(__MINGW32__)
  Term t = MkIntTerm('\\');
#else
  Term t = MkIntTerm('/');
#endif

  return(unify_constant(ARG1,t));
}


int page_size;

static void
InitPageSize(void)
{
#ifdef _WIN32
  SYSTEM_INFO si;
  GetSystemInfo(&si);
  page_size = si.dwPageSize;
#elif HAVE_UNISTD_H
#ifdef __FreeBSD__
  page_size = getpagesize();
#elif defined(_AIX)
  page_size = sysconf(_SC_PAGE_SIZE);
#elif !defined(_SC_PAGESIZE)
  page_size = getpagesize();
#else
  page_size = sysconf(_SC_PAGESIZE);
#endif
#else
bla bla
#endif
}

#ifdef SIMICS
#ifdef HAVE_GETRUSAGE
#undef HAVE_GETRUSAGE
#endif
#ifdef HAVE_TIMES
#undef HAVE_TIMES
#endif
#endif /* SIMICS */

#ifdef _WIN32
#if HAVE_GETRUSAGE
#undef HAVE_GETRUSAGE
#endif
#endif

#if HAVE_GETRUSAGE

#if HAVE_SYS_TIMES_H
#include <sys/times.h>
#endif
#if HAVE_SYS_RESOURCE_H
#include <sys/resource.h>
#endif

/* since the point YAP was started */
static struct timeval StartOfTimes;

/* since last call to runtime */
static struct timeval last_time;

/* store user time in this variable */
static void
InitTime (void)
{
  struct rusage   rusage;

  getrusage(RUSAGE_SELF, &rusage);
  last_time.tv_sec = StartOfTimes.tv_sec = rusage.ru_utime.tv_sec;
  last_time.tv_usec = StartOfTimes.tv_usec = rusage.ru_utime.tv_usec;
}


Int
cputime (void)
{
 struct rusage   rusage;

 getrusage(RUSAGE_SELF, &rusage);
 return((rusage.ru_utime.tv_sec - StartOfTimes.tv_sec)) * 1000 +
   ((rusage.ru_utime.tv_usec - StartOfTimes.tv_usec) / 1000);
}

void cputime_interval(Int *now,Int *interval)
{
  struct rusage   rusage;

  getrusage(RUSAGE_SELF, &rusage);
  *now = (rusage.ru_utime.tv_sec - StartOfTimes.tv_sec) * 1000 +
    (rusage.ru_utime.tv_usec - StartOfTimes.tv_usec) / 1000;
  *interval = (rusage.ru_utime.tv_sec - last_time.tv_sec) * 1000 +
    (rusage.ru_utime.tv_usec - last_time.tv_usec) / 1000;
  last_time.tv_usec = rusage.ru_utime.tv_usec;
  last_time.tv_sec = rusage.ru_utime.tv_sec;
}

#elif defined(_WIN32)

#ifdef __GNUC__

/* This is stolen from the Linux kernel.
   The problem is that mingw32 does not seem to have acces to div */
#ifndef do_div
#define do_div(n,base) ({ \
	unsigned long __upper, __low, __high, __mod; \
	asm("":"=a" (__low), "=d" (__high):"A" (n)); \
	__upper = __high; \
	if (__high) { \
		__upper = __high % (base); \
		__high = __high / (base); \
	} \
	asm("divl %2":"=a" (__low), "=d" (__mod):"rm" (base), "0" (__low), "1" (__upper)); \
	asm("":"=A" (n):"a" (__low),"d" (__high)); \
	__mod; \
})
#endif

#endif



#include <time.h>

static FILETIME StartOfTimes, last_time;

/* store user time in this variable */
static void
InitTime (void)
{
  HANDLE hProcess = GetCurrentProcess();
  FILETIME CreationTime, ExitTime, KernelTime, UserTime;
  if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) 
    WinError("could not query cputime");
  last_time.dwLowDateTime = UserTime.dwLowDateTime;
  last_time.dwHighDateTime = UserTime.dwHighDateTime;
  StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
  StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
}

Int
cputime (void)
{
  HANDLE hProcess = GetCurrentProcess();
  FILETIME CreationTime, ExitTime, KernelTime, UserTime;
  if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) 
    WinError("could not query cputime");
#ifdef __GNUC__
  {
    unsigned long long int t =
      *(unsigned long long int *)&UserTime - 
      *(unsigned long long int *)&StartOfTimes;
    return((Int)do_div(t,10000));
#endif
#ifdef _MSC_VER
    LONG_INTEGER t = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&StartOfTimes;
    return((Int)(t/10000));
#endif
  }
}

void cputime_interval(Int *now,Int *interval)
{
  HANDLE hProcess = GetCurrentProcess();
  FILETIME CreationTime, ExitTime, KernelTime, UserTime;
  if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) 
    WinError("could not query cputime");
  {
#ifdef __GNUC__
    unsigned long long int t1 =
      *(unsigned long long int *)&UserTime -
      *(unsigned long long int *)&StartOfTimes;
    unsigned long long int t2 =
      *(unsigned long long int *)&UserTime -
      *(unsigned long long int *)&last_time;
    *now = (Int)do_div(t1,10000);
    *interval = (Int)do_div(t2,10000);
#endif
#ifdef _MSC_VER
    LONG_INTEGER t1 = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&StartOfTimes;
    LONG_INTEGER t2 = *(LONG_INTEGER *)&UserTime - *(LONG_INTEGER *)&last_time;
    *now = (Int)(t1/10000);
    *interval = (Int)(t2/10000);
#endif
    last_time.dwLowDateTime = UserTime.dwLowDateTime;
    last_time.dwHighDateTime = UserTime.dwHighDateTime;
  }
}

#elif HAVE_TIMES

#if defined(_WIN32)

#include <time.h>

#define TicksPerSec     CLOCKS_PER_SEC

#else

#if HAVE_SYS_TIMES_H
#include <sys/times.h>
#endif

#endif

#if defined(__sun__) && defined(__svr4__)

#if HAVE_LIMITS_H
#include <limits.h>
#endif

#define TicksPerSec	CLK_TCK
#endif

#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__)

#if HAVE_TIME_H
#include <time.h>
#endif

#define TicksPerSec	sysconf(_SC_CLK_TCK)

#endif

#if !TMS_IN_SYS_TIME
#if HAVE_SYS_TIMES_H
#include <sys/times.h>
#endif
#endif

static clock_t StartOfTimes, last_time;

/* store user time in this variable */
static void
InitTime (void)
{
  struct tms t;
  times (&t);
  last_time = StartOfTimes = t.tms_utime;
}

Int
cputime (void)
{
  struct tms t;
  times(&t);
  return((t.tms_utime - StartOfTimes)*1000 / TicksPerSec);
}

void cputime_interval(Int *now,Int *interval)
{
  struct tms t;
  times (&t);
  *now = ((t.tms_utime - StartOfTimes)*1000) / TicksPerSec;
  *interval = (t.tms_utime - last_time) * 1000 / TicksPerSec;
  last_time = t.tms_utime;
}

#else /* HAVE_TIMES */

#ifdef SIMICS

#include <sys/time.h>

/* since the point YAP was started */
static struct timeval StartOfTimes;

/* since last call to runtime */
static struct timeval last_time;

/* store user time in this variable */
static void
InitTime (void)
{
  struct timeval   tp;

  gettimeofday(&tp,NULL);
  last_time.tv_sec = StartOfTimes.tv_sec = tp.tv_sec;
  last_time.tv_usec = StartOfTimes.tv_usec = tp.tv_usec;
}


Int
cputime (void)
{
  struct timeval   tp;

  gettimeofday(&tp,NULL);
  if (StartOfTimes.tv_usec > tp.tv_usec)
    return((tp.tv_sec - StartOfTimes.tv_sec - 1) * 1000 +
	   (StartOfTimes.tv_usec - tp.tv_usec) /1000);
  else
    return((tp.tv_sec - StartOfTimes.tv_sec)) * 1000 +
      ((tp.tv_usec - StartOfTimes.tv_usec) / 1000);
}

void cputime_interval(Int *now,Int *interval)
{
  struct timeval   tp;

  gettimeofday(&tp,NULL);
  *now = (tp.tv_sec - StartOfTimes.tv_sec) * 1000 +
    (tp.tv_usec - StartOfTimes.tv_usec) / 1000;
  *interval = (tp.tv_sec - last_time.tv_sec) * 1000 +
    (tp.tv_usec - last_time.tv_usec) / 1000;
  last_time.tv_usec = tp.tv_usec;
  last_time.tv_sec = tp.tv_sec;
}

#endif /* SIMICS */

#ifdef COMMENTED_OUT
/* This code is not working properly. I left it here to help future ports */
#ifdef MPW

#include <files.h>
#include <Events.h>

#define TicksPerSec 60.0

static double
real_cputime ()
{
  return (((double) TickCount ()) / TicksPerSec);
}

#endif /* MPW */

#ifdef LATTICE

#include "osbind.h"

static long *ptime;

gettime ()
{
  *ptime = *(long *) 0x462;
}

static double
real_cputime ()
{
  long thetime;
  ptime = &thetime;
  xbios (38, gettime);
  return (((double) thetime) / (Getrez () == 2 ? 70 : 60));
}

#endif /* LATTICE */

#ifdef M_WILLIAMS

#include <osbind.h>
#include <xbios.h>

static long *ptime;

static long
readtime ()
{
  return (*((long *) 0x4ba));
}

static double
real_cputime ()
{
  long time;

  time = Supexec (readtime);
  return (time / 200.0);
}

#endif /* M_WILLIAMS */

#ifdef LIGHT

#undef FALSE
#undef TRUE

#include <FileMgr.h>

#define TicksPerSec 60.0

static double
real_cputime ()
{
  return (((double) TickCount ()) / TicksPerSec);
}

#endif /* LIGHT */

#endif /* COMMENTED_OUT */

#endif /* HAVE_GETRUSAGE */

#if HAVE_GETHRTIME
/* since the point YAP was started */
static hrtime_t StartOfWTimes;

/* since last call to walltime */
#define  LastWtime (*(hrtime_t *)ALIGN_YAPTYPE(LastWtimePtr,hrtime_t))

static void
InitWTime (void)
{
  StartOfWTimes = gethrtime();
}

static void
InitLastWtime(void) {
  /* ask for twice the space in order to guarantee alignment */
  LastWtimePtr = (void *)AllocCodeSpace(2*sizeof(hrtime_t));
  LastWtime = StartOfWTimes;
}

Int
walltime (void)
{
  hrtime_t tp = gethrtime();
  /* return time in milliseconds */
  return((Int)((tp-StartOfWTimes)/((hrtime_t)1000000)));

}

void walltime_interval(Int *now,Int *interval)
{
  hrtime_t tp = gethrtime();
  /* return time in milliseconds */
  *now = (Int)((tp-StartOfWTimes)/((hrtime_t)1000000));
  *interval = (Int)((tp-LastWtime)/((hrtime_t)1000000));
  LastWtime = tp;
}


#elif HAVE_GETTIMEOFDAY

/* since the point YAP was started */
static struct timeval StartOfWTimes;

/* since last call to walltime */
#define LastWtime (*(struct timeval *)LastWtimePtr)

/* store user time in this variable */
static void
InitWTime (void)
{
  gettimeofday(&StartOfWTimes,NULL);
}

static void
InitLastWtime(void) {
  LastWtimePtr = (void *)AllocCodeSpace(sizeof(struct timeval));
  LastWtime.tv_usec = StartOfWTimes.tv_usec;
  LastWtime.tv_sec = StartOfWTimes.tv_sec;
}


Int
walltime (void)
{
  struct timeval   tp;

  gettimeofday(&tp,NULL);
  if (StartOfWTimes.tv_usec > tp.tv_usec)
    return((tp.tv_sec - StartOfWTimes.tv_sec - 1) * 1000 +
	   (StartOfWTimes.tv_usec - tp.tv_usec) /1000);
  else
    return((tp.tv_sec - StartOfWTimes.tv_sec)) * 1000 +
      ((tp.tv_usec - LastWtime.tv_usec) / 1000);
}

void walltime_interval(Int *now,Int *interval)
{
  struct timeval   tp;

  gettimeofday(&tp,NULL);
  *now = (tp.tv_sec - StartOfWTimes.tv_sec) * 1000 +
    (tp.tv_usec - StartOfWTimes.tv_usec) / 1000;
  *interval = (tp.tv_sec - LastWtime.tv_sec) * 1000 +
    (tp.tv_usec - LastWtime.tv_usec) / 1000;
  LastWtime.tv_usec = tp.tv_usec;
  LastWtime.tv_sec = tp.tv_sec;
}

#elif defined(_WIN32)

#include <sys/timeb.h>
#include <time.h>

/* since the point YAP was started */
static struct timeb StartOfWTimes;

/* since last call to walltime */
#define LastWtime (*(struct timeb *)LastWtimePtr)

/* store user time in this variable */
static void
InitWTime (void)
{
  ftime(&StartOfWTimes);
}

static void
InitLastWtime(void) {
  LastWtimePtr = (void *)AllocCodeSpace(sizeof(struct timeb));
  LastWtime.time = StartOfWTimes.time;
  LastWtime.millitm = StartOfWTimes.millitm;
}


Int
walltime (void)
{
  struct timeb   tp;

  ftime(&tp);
  if (StartOfWTimes.millitm > tp.millitm)
    return((tp.time - StartOfWTimes.time - 1) * 1000 +
	   (StartOfWTimes.millitm - tp.millitm));
  else
    return((tp.time - StartOfWTimes.time)) * 1000 +
      ((tp.millitm - LastWtime.millitm) / 1000);
}

void walltime_interval(Int *now,Int *interval)
{
  struct timeb   tp;

  ftime(&tp);
  *now = (tp.time - StartOfWTimes.time) * 1000 +
    (tp.millitm - StartOfWTimes.millitm);
  *interval = (tp.time - LastWtime.time) * 1000 +
    (tp.millitm - LastWtime.millitm) ;
  LastWtime.millitm = tp.millitm;
  LastWtime.time = tp.time;
}

#elif HAVE_TIMES

static clock_t StartOfWTimes;

#define LastWtime (*(clock_t *)LastWtimePtr)

/* store user time in this variable */
static void
InitWTime (void)
{
  StartOfWTimes = times(NULL);
}

static void
InitLastWtime(void) {
  LastWtimePtr = (void *)AllocCodeSpace(sizeof(clock_t));
  LastWtime = StartOfWTimes;
}

Int
walltime (void)
{
  clock_t t;
  t = times(NULL);
  return ((t - StartOfWTimes)*1000 / TicksPerSec));
}

void walltime_interval(Int *now,Int *interval)
{
  clock_t t;
  t = times(NULL);
  *now = ((t - StartOfWTimes)*1000) / TicksPerSec;
  *interval = (t - LastWtime) * 1000 / TicksPerSec;
}

#endif /* HAVE_TIMES */

#if HAVE_TIME_H
#include <time.h>
#endif

unsigned int current_seed;

static void
InitRandom (void)
{
  current_seed = (unsigned int) time (NULL);
#if HAVE_RANDOM
  srandom (current_seed);
#elif HAVE_RAND
  srand (current_seed);
#endif
}

STD_PROTO (extern int rand, (void));


double
yap_random (void)
{
#if HAVE_RANDOM
/*  extern long random (); */
  return (((double) random ()) / 0x7fffffffL /* 2**31-1 */);
#elif HAVE_RAND
  return (((double) (rand ()) / RAND_MAX));
#else
  Error(SYSTEM_ERROR, TermNil,
	"random not available in this configuration");
  return (0.0);
#endif
}

static Int
p_srandom (void)
{
  register Term t0 = Deref (ARG1);
  if (IsVarTerm (t0)) {
    return(unify(ARG1,MkIntegerTerm((Int)current_seed)));
  }
  if(!IsNumTerm (t0))
    return (FALSE);
  if (IsIntTerm (t0))
    current_seed = (unsigned int) IntOfTerm (t0);
  else if (IsFloatTerm (t0))
    current_seed  = (unsigned int) FloatOfTerm (t0);
  else
    current_seed  = (unsigned int) LongIntOfTerm (t0);
#if HAVE_RANDOM
  srandom(current_seed);
#elif HAVE_RAND
  srand(current_seed);
#endif
  return (TRUE);
}

#if HAVE_SIGNAL

#include <signal.h>

#ifdef MPW
#define signal	sigset
#endif


#ifdef MSH

#define SIGFPE	SIGDIV

#endif

STATIC_PROTO (void InitSignals, (void));


#if defined(__svr4__)

#if HAVE_SIGINFO_H
#include <siginfo.h>
#endif
#if HAVE_SYS_UCONTEXT_H
#include <sys/ucontext.h>
#endif

STATIC_PROTO (void HandleSIGSEGV, (int, siginfo_t   *, ucontext_t *));
STATIC_PROTO (void HandleMatherr,  (int, siginfo_t   *, ucontext_t *));
STATIC_PROTO (void my_signal_info, (int, void (*)(int, siginfo_t  *, ucontext_t *)));
STATIC_PROTO (void my_signal, (int, void (*)(int, siginfo_t  *, ucontext_t *)));

/* This routine believes there is a continuous space starting from the
   HeapBase and ending on TrailTop */
static void
HandleSIGSEGV(int   sig,   siginfo_t   *sip, ucontext_t *uap)
{
  if (sip->si_code != SI_NOINFO &&
      sip->si_code == SEGV_MAPERR &&
      (void *)(sip->si_addr) > (void *)(HeapBase) &&
      (void *)(sip->si_addr) < (void *)(TrailTop+64 * 1024L) ) {
    growtrail(64 * 1024L);
  }
  else {
    Error(INTERNAL_ERROR, TermNil,
	  "likely bug in YAP, segmentation violation at %p", sip->si_addr);
  }
}


static void
HandleMatherr(int  sig, siginfo_t *sip, ucontext_t *uap)
{
  yap_error_number error_no;

  /* reset the registers so that we don't have trash in abstract machine */

  switch(sip->si_code) {
  case FPE_INTDIV:
    error_no = EVALUATION_ERROR_ZERO_DIVISOR;
    break;
  case FPE_INTOVF:
    error_no = EVALUATION_ERROR_INT_OVERFLOW;
    break;
  case FPE_FLTDIV:
    error_no = EVALUATION_ERROR_ZERO_DIVISOR;
    break;
  case FPE_FLTOVF:
    error_no = EVALUATION_ERROR_FLOAT_OVERFLOW;
    break;
  case FPE_FLTUND:
    error_no = EVALUATION_ERROR_FLOAT_UNDERFLOW;
    break;
  case FPE_FLTRES:
  case FPE_FLTINV:
  case FPE_FLTSUB:
  default:
    error_no = EVALUATION_ERROR_UNDEFINED;
  }
  YAP_matherror = error_no;
  siglongjmp(RestartEnv, 2);  
}


static void
my_signal_info(int sig, void (*handler)(int, siginfo_t  *, ucontext_t *))
{
  struct sigaction sigact;

  sigact.sa_handler = handler;
  sigemptyset(&sigact.sa_mask);
  sigact.sa_flags = SA_SIGINFO|SA_RESTART;

  sigaction(sig,&sigact,NULL);
}

static void
my_signal(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
{
  struct sigaction sigact;

  sigact.sa_handler=handler;
  sigemptyset(&sigact.sa_mask);
  sigact.sa_flags = 0
;

  sigaction(sig,&sigact,NULL);
}

#else

STATIC_PROTO (RETSIGTYPE HandleMatherr, (int));
STATIC_PROTO (RETSIGTYPE HandleSIGSEGV, (int));
STATIC_PROTO (void my_signal_info, (int, void (*)(int)));
STATIC_PROTO (void my_signal, (int, void (*)(int)));

/******** Handling floating point errors *******************/


/* old code, used to work with matherror(), deprecated now:
  char err_msg[256];
  switch (x->type)
    {
    case DOMAIN:
    case SING:
      Error(EVALUATION_ERROR_UNDEFINED, TermNil, "%s", x->name);
      return(0);
    case OVERFLOW:
      Error(EVALUATION_ERROR_FLOAT_OVERFLOW, TermNil, "%s", x->name);
      return(0);
    case UNDERFLOW:
      Error(EVALUATION_ERROR_FLOAT_UNDERFLOW, TermNil, "%s", x->name);
      return(0);
    case PLOSS:
    case TLOSS:
      Error(EVALUATION_ERROR_UNDEFINED, TermNil, "%s(%g) = %g", x->name,
	       x->arg1, x->retval);
      return(0);
    default:
      Error(EVALUATION_ERROR_UNDEFINED, TermNil, NULL);
      return(0);
    }
  */


#if HAVE_FENV_H
#include <fenv.h>
#endif

#ifdef __linux__
/* fetestexcept does not seem to work in linux :-( :-( */
#undef HAVE_FETESTEXCEPT
#endif

static RETSIGTYPE
HandleMatherr(int sig)
{
#if HAVE_FETESTEXCEPT

  /* This should work in Linux, but it doesn't seem to. */
  
  int raised = fetestexcept(FE_ALL_EXCEPT);

  feclearexcept(FE_ALL_EXCEPT);
  if (raised & FE_OVERFLOW) {
    YAP_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
  } else if (raised & (FE_INVALID|FE_INEXACT)) {
    YAP_matherror = EVALUATION_ERROR_UNDEFINED;
  } else if (raised & FE_DIVBYZERO) {
    YAP_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
  } else if (raised & FE_UNDERFLOW) {
    YAP_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
  } else {
    YAP_matherror = EVALUATION_ERROR_UNDEFINED;
  }
    else
#endif
      YAP_matherror = EVALUATION_ERROR_UNDEFINED;
  /* something very bad happened on the way to the forum */
  my_signal (SIGFPE, HandleMatherr);
  /* do a longjmp because Linux is an idiot, and it makes our life
     easier anyway, but not an abort!!
  */ 
  siglongjmp(RestartEnv, 2);  
}

static void
SearchForTrailFault(void)
{
  /* If the TRAIL is very close to the top of mmaped allocked space,
     then we can try increasing the TR space and restarting the
     instruction. In the worst case, the system will
     crash again
     */
#ifdef DEBUG
  /*  fprintf(stderr,"Catching a sigsegv at %p with %p\n", TR, TrailTop); */
#endif
#ifndef FIXED_STACKS
  if ((TR > (tr_fr_ptr)TrailTop-1024  && 
       TR < (tr_fr_ptr)TrailTop+(64*1024))|| DBTrailOverflow()) {
    if (!growtrail(64 * 1024L)) {
      YP_fprintf(YP_stderr, "[ ERROR: YAP failed to reserve %ld bytes in growtrail ]\n",64*1024L);
      Abort("");
    }
    /* just in case, make sure the OS keeps the signal handler. */
    /*    my_signal_info(SIGSEGV, HandleSIGSEGV); */
  } else
#endif /* FIXED_STACKS */
    Error(FATAL_ERROR, TermNil,
	  "likely bug in YAP, segmentation violation");
}

static RETSIGTYPE
HandleSIGSEGV(int   sig)
{
  SearchForTrailFault();
}

#ifdef HAVE_SIGACTION

#if !defined(SA_RESTART)
/* sunos machine has no SA_RESTART, as most other 4.2BSD based machines */
#define SA_RESTART 0
#endif

static void
my_signal_info(int sig, void (*handler)(int))
{
  struct sigaction sigact;

  sigact.sa_handler = handler;
  sigemptyset(&sigact.sa_mask);
  sigact.sa_flags = SA_RESTART;

  sigaction(sig,&sigact,NULL);
}

static void
my_signal(int sig, void (*handler)(int))
{
  struct sigaction sigact;

  sigact.sa_handler=handler;
  sigemptyset(&sigact.sa_mask);
  sigact.sa_flags = SA_RESTART;

  sigaction(sig,&sigact,NULL);
}

#else

static void
my_signal(int sig, void (*handler)(int))
{
  signal(sig, handler);
}

static void
my_signal_info(sig, handler)
int sig;
void (*handler)(int);
{
  if(signal(sig, handler) == SIG_ERR)
    exit(1);
}
#endif /* __linux__ */

#endif

void
ProcessSIGINT(void)
{

  while (TRUE) {
    int ch;
#ifdef MPW
    int ch0;
#endif

    YP_fprintf(YP_stderr, "\nAction (h for help): ");
    ch = YP_getchar ( );
#if  HAVE_LIBREADLINE
    if (!in_readline)
#endif
      while ((YP_getchar()) != '\n');
    switch (ch)
      {
      case 'a':
	/* abort computation, but take care in case we are within readline
	   code */
	if (!(PrologMode & CritMode))
	  {
#if HAVE_SIGPROCMASK
	    sigset_t sig_set;
	    sigemptyset(&sig_set);
	    sigaddset(&sig_set, SIGINT);
	    sigprocmask(SIG_UNBLOCK, &sig_set, NULL);
#elif HAVE_SIGGETMASK
	    sigsetmask (siggetmask () ^ (1 << (SIGINT - 1)));
#endif
#ifdef VAX
	    VaxFixFrame (CritMode);
#endif
#if  HAVE_LIBREADLINE
	    /* we cannot abort until we finish readline :-( */
	    if (in_readline) {
	      /* readline must eat a newline, otherwise we will
		 have to wait before we do the Abort() */
	    } else {
#endif
#if defined(__MINGW32__) || _MSC_VER
	      /* we can't do a direct abort, so ask the system to do it for us */
	      p_creep();
	      PutValue(AtomThrow, MkAtomTerm(AtomTrue));
#else
	      Abort ((char *) NULL);
#endif
#if   HAVE_LIBREADLINE
	    }
#endif
	  }
	PrologMode |= AbortMode;
	return;
      case 'c':
	/* continue */
	return;
      case 'e':
	/* exit */
	exit_yap(0, "");
      case 't':
	/* start tracing */
	PutValue (LookupAtom ("debug"), MkIntTerm (1));
	PutValue (LookupAtom ("spy_sl"), MkIntTerm (0));
	PutValue (LookupAtom ("spy_creep"), MkIntTerm (1));
	p_creep ();
	return;
#ifdef LOW_LEVEL_TRACER
      case 'T':
	toggle_low_level_trace();
	return;
#endif
      case 'd':
	/* enter debug mode */
	PutValue (LookupAtom ("debug"), MkIntTerm (1));
	return;
      case 's':
	/* show some statistics */
#if SHORT_INTS==0
	YP_fprintf(YP_stderr, "aux. stack: %d ", Unsigned (AuxTop) -
		   Unsigned (LCL0 + 1));
	if (Unsigned (AuxSp) <= Unsigned (LCL0))
	  YP_fprintf(YP_stderr, "( 0 bytes used)\n");
	else
	  YP_fprintf(YP_stderr, "( %d bytes used)\n",
		     Unsigned (AuxSp) - Unsigned (LCL0 + 1));
	YP_fprintf(YP_stderr, "heap space: %d ", Unsigned (AuxTop) -
		   Unsigned (HeapBase));
	YP_fprintf(YP_stderr, "( %d bytes used for heap",
		   Unsigned (HeapUsed));
	YP_fprintf(YP_stderr, " and %d bytes used for trail)\n",
		   Unsigned (TR) - Unsigned (TrailBase));
	YP_fprintf(YP_stderr, "stack space: %d ", Unsigned (LCL0) -
		   Unsigned (H0));
	YP_fprintf(YP_stderr, "( %d bytes used for local",
		   Unsigned (LCL0) - Unsigned (ASP));
	YP_fprintf(YP_stderr, " and %d bytes used for global)\n",
		   Unsigned (H) - Unsigned (H0));
#else
	YP_fprintf(YP_stderr, "aux. stack: %ld ", Unsigned (AuxTop) -
		   Unsigned (LCL0 + 1));
	if (Unsigned (AuxSp) <= Unsigned (LCL0))
	  YP_fprintf(YP_stderr, "( 0 bytes used)\n");
	else
	  YP_fprintf(YP_stderr, "( %ld bytes used)\n",
		     Unsigned (AuxSp) - Unsigned (LCL0 + 1));
	YP_fprintf(YP_stderr, "heap space: %ld ", Unsigned (AuxTop) -
		   Unsigned (HeapBase));
	YP_fprintf(YP_stderr, "( %ld bytes used for heap",
		   Unsigned (HeapUsed));
	YP_fprintf(YP_stderr, " and %ld bytes used for trail)\n",
		   Unsigned (TR) - Unsigned (TrailBase));
	YP_fprintf(YP_stderr, "stack space: %ld ", Unsigned (LCL0) -
		   Unsigned (H0));
	YP_fprintf(YP_stderr, "( %ld bytes used for local",
		   Unsigned (LCL0) - Unsigned (ASP));
	YP_fprintf(YP_stderr, " and %ld bytes used for global)\n",
		   Unsigned (H) - Unsigned (H0));
#endif
#if SHORT_INTS
	YP_fprintf(YP_stderr, "Runtime: %lds.\n", runtime ());
	YP_fprintf(YP_stderr, "Cputime: %lds.\n", cputime ());
	YP_fprintf(YP_stderr, "Walltime: %lds.\n", walltime ());
#else
	YP_fprintf(YP_stderr, "Runtime: %ds.\n", runtime ());
	YP_fprintf(YP_stderr, "Cputime: %ds.\n", cputime ());
	YP_fprintf(YP_stderr, "Walltime: %ds.\n", walltime ());
#endif
	break;
      case EOF:
	/* ignore end of file */
	break;
      case 'h':
      case '?':
      default:
	/* show an helpful message */
	YP_fprintf(YP_stderr, "Please press one of:\n");
	YP_fprintf(YP_stderr, "  a for abort\n  c for continue\n  d for debug\n");
	YP_fprintf(YP_stderr, "  e for exit\n  t for trace\n  s for statistics\n");
	break;
      }
#if  HAVE_LIBREADLINE
    /* we must do the reading now, because libreadline won't have a chance here */
    while ((YP_getchar()) != '\n');
#endif
  }
}

static RETSIGTYPE
#if defined(__svr4__)
HandleSIGINT (int sig, siginfo_t   *x, ucontext_t *y)
#else
HandleSIGINT (int sig)
#endif
{
#if defined(__MINGW32__) || _MSC_VER
  extern int in_getc;

  if (in_getc) {
    /*    YP_ungetc(YP_stdin,'\n');
	  PrologMode |= InterruptMode; */
    in_getc = FALSE;
    return;
  }
#else
#ifdef HAVE_SETBUF
  /* make sure we are not waiting for the end of line */
  YP_setbuf (YP_stdin, NULL); 
#endif
  my_signal(SIGINT, HandleSIGINT);
#endif
  if (snoozing)
    {
      snoozing = FALSE;
      return;
    }
  ProcessSIGINT();
}

#if !defined(_WIN32)
/* this routine is called if the system activated the alarm */
static RETSIGTYPE
#if defined(__svr4__)
HandleALRM (int s, siginfo_t   *x, ucontext_t *y)
#else
HandleALRM(int s)
#endif
{
  /* force the system to creep */
  p_creep ();
  /* now, say what is going on */
  PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
  my_signal (SIGALRM, HandleALRM);
}
#endif

/*
 * This function is called after a normal interrupt had been caught It allows
 * 6 possibilities : abort, continue, trace, debug, help, exit
 */

static RETSIGTYPE
#if defined(__svr4__)
ReceiveSignal (int s, siginfo_t   *x, ucontext_t *y)
#else
ReceiveSignal (int s)
#endif
{
  switch (s)
    {
#ifndef MPW
    case SIGFPE:
      my_signal (SIGFPE, HandleMatherr);
      Abort ("[ Fatal error: floating point exception ]");
      break;
#endif
#if !defined(LIGHT) && !defined(_WIN32)
      /* These signals are not handled by WIN32 and not the Macintosh */
    case SIGQUIT:
    case SIGKILL:
      exit_yap (SIGKILL, "\n\n\n[ Quit signal received ]\n\n");
#endif
    default:
      YP_fprintf(YP_stderr, "\n[ Unexpected signal ]\n");
      exit (FALSE);
    }
}

#if _MSC_VER || defined(__MINGW32__)
static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) {
  switch(dwCtrlType) {
  case CTRL_C_EVENT:
    HandleSIGINT(SIGINT);
    break;
  case CTRL_BREAK_EVENT:
    HandleSIGINT(SIGINT);
    break;
  default:
    exit_yap(1, "[ SYSTEM ERROR: Received Termination Event ]\n");
  }
  return(TRUE);
}
#endif

/* SIGINT can cause problems, if caught before full initialization */
static void
InitSignals (void)
{
#if _MSC_VER || defined(__MINGW32__)
  SetConsoleCtrlHandler(MSCHandleSignal,TRUE);
#else
  my_signal (SIGINT, HandleSIGINT);
#ifndef MPW
  my_signal (SIGFPE, HandleMatherr);
#if !defined(LIGHT) && !defined(_WIN32)
  my_signal (SIGQUIT, ReceiveSignal);
#endif
#endif
#if !defined(LIGHT) && !defined(_WIN32)
  my_signal (SIGKILL, ReceiveSignal);
#endif
#if HAVE_SIGSEGV
  my_signal_info (SIGSEGV, HandleSIGSEGV);
#endif
#if !defined(LIGHT) && !defined(_WIN32)
  my_signal(SIGALRM, HandleALRM);
#endif
#endif
#ifdef ACOW
  signal(SIGCHLD, SIG_IGN);  /* avoid ghosts */ 
#endif
}


#endif /* HAVE_SIGNAL */


char *
pfgets (char *s, int n, FILE *stream)
{
  char *res;
  do
    res = YP_fgets (s, n, stream);
  while (res == NULL && errno == EINTR);
  return (res);
}

/* TrueFileName -> Finds the true name of a file */

#ifdef __MINGW32__
#include <ctype.h>
#endif

int
volume_header(char *file)
{
#if _MSC_VER || defined(__MINGW32__)
  char *ch = file;
  int c;

  while ((c = ch[0]) != '\0') {
    if (isalnum(c)) ch++;
    else return(c == ':');
  }
#endif
  return(FALSE);
}

int TrueFileName (char *source, char *result, int in_lib)
{
  register int ch;
  register char *res0 = result, *work;
  char ares1[YAP_FILENAME_MAX], *res1 = ares1;
  char *var_name;

  result[0] = '\0';
#if defined(__MINGW32__) || _MSC_VER
  /* step 0: replace / by \ */
  {
    char *p = source, ch = p[0];
    while (ch != '\0') {
      if (ch == '/') p[0] = '\\';
      p++;
      ch = p[0];
    }
  }
#endif
  /* step 1: eating home information */
  if (source[0] == '~')
    {
      if (dir_separator(source[1]) || source[1] == '\0')
	{
	  char *s;
	  source++;
#if defined(_WIN32)
	  s = getenv("HOMEDRIVE");
	  if (s != NULL)
	    strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX);
	  s = getenv("HOMEPATH");
	  if (s != NULL)
	    strncpy (result, s, YAP_FILENAME_MAX);
#else
	  s = getenv ("HOME");
	  if (s != NULL)
	    strncpy (result, s, YAP_FILENAME_MAX);
#endif
	}
#if HAVE_GETPWNAM
      else
	{
	  struct passwd *user_passwd;

	  source++;
	  while (!dir_separator((*res0 = *source)) && *res0 != '\0')
	    res0++, source++;
	  *res0++ = '\0';
	  if ((user_passwd = getpwnam (result)) == NULL)
	    {
	      return(FALSE);
	    }
	  strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
	}
#endif
      strncat (result, source, YAP_FILENAME_MAX);
    }
  else
    strncpy (result, source, YAP_FILENAME_MAX);
  /* step 2: handling environment variables in file names */
  strncpy (ares1, result, YAP_FILENAME_MAX);
  res0 = result;
  while ((ch = *res1++)!=0)
    {
      if (ch == '\\' && !dir_separator('\\'))
	{
	  ch = *res1++;
	  if (ch == '\0')
	    {
	      *res0 = '\0';
	      break;
	    }
	  else
	    *res0++ = ch;
	}
      if (ch != '$')
	*res0++ = ch;
      else
	{
	  char env_var[256], *sptr = env_var;
	  while (((ch = *res1)!=0) && is_valid_env_char (ch))
	    {
	      res1++;
	      *sptr++ = ch;
	    }
	  *sptr = '\0';
	  if ((var_name = (char *) getenv (env_var)) == NULL)
	    {
	      return(FALSE);
	    }
	  else
	    while ((*res0 = *var_name++)!=0)
	      res0++;
	}
    }
  *res0 = '\0';
  /* step 3: get the full file name */
  if (!dir_separator(result[0]) && !volume_header(result))
    {

#if __simplescalar__
      /* does not implement getcwd */
      strncpy(ares1,".",YAP_FILENAME_MAX);
#elif HAVE_GETCWD
      if (getcwd (ares1, YAP_FILENAME_MAX) == NULL)
	return (FALSE);
#else
      if (getwd (ares1) == NULL)
	return (FALSE);
#endif
#if _MSC_VER || defined(__MINGW32__)
      strncat (ares1, "\\", YAP_FILENAME_MAX);
#else
      strncat (ares1, "/", YAP_FILENAME_MAX);
#endif
      strncat (ares1, result, YAP_FILENAME_MAX);
      if (in_lib) {
	int tmpf;
	if ((tmpf = open(ares1, O_RDONLY)) < 0) {
	  /* not in current directory, let us try the library */
	  if  (Yap_LibDir != NULL) {
	    strncpy(FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX);
#if HAVE_GETENV
	  } else {
	    char *yap_env = getenv("YAPLIBDIR");
	    if (yap_env != NULL) {
	      strncpy(ares1, yap_env, YAP_FILENAME_MAX);
#endif
	    } else {
	      strncpy(ares1, LIB_DIR, YAP_FILENAME_MAX);
	    }
#if HAVE_GETENV
	  }
#endif
#if _MSC_VER || defined(__MINGW32__)
	  strncat(ares1,"\\", YAP_FILENAME_MAX);
#else
	  strncat(ares1,"/", YAP_FILENAME_MAX);
#endif
	  strncat(ares1,result, YAP_FILENAME_MAX);
	  if ((tmpf = open(ares1, O_RDONLY)) >= 0) {
	    close(tmpf);
	    strncpy (result, ares1, YAP_FILENAME_MAX);
	  }
	} else {
	  strncpy (result, ares1, YAP_FILENAME_MAX);
	  close(tmpf);
	}
      } else {
	strncpy (result, ares1, YAP_FILENAME_MAX);
      }
    }
  /* step 4: simplifying the file name */
  work = result;
  while (*work != '\0')
    {
      char *new_work, *next_work;
      if (*work++ != '.')
	continue;
      if (*work != '.')
	{
	  if (!dir_separator(*work) || !dir_separator(work[-2]))
	    continue;
	  next_work = work + 1;
	  new_work = --work;
	}
      else
	{
	  if (!dir_separator(work[1]) || !dir_separator(work[-2]))
	    continue;
	  next_work = work + 2;
	  work -= 2;
	  if (work == result)
	    return (FALSE);
	  while (!dir_separator(*--work) && work != result);
	  if (work == result && !dir_separator(work[0]))
	    return (FALSE);
	  new_work = ++work;
	}
      while ((*new_work++ = *next_work++)!=0);
    }
  return (TRUE);
}

static Int
p_getcwd(void)
{
  Term t;

#if __simplescalar__
  /* does not implement getcwd */
  strncpy(FileNameBuf,".",YAP_FILENAME_MAX);
#elif HAVE_GETCWD
  if (getcwd (FileNameBuf, YAP_FILENAME_MAX) == NULL)
    return (FALSE);
#else
  if (getwd (FileNameBuf) == NULL)
    return (FALSE);
#endif

  t = StringToList(FileNameBuf);
  return(unify(ARG1,t));

}

/* Executes $SHELL under Prolog */

static Int
p_sh (void)
{				/* sh				 */
#ifdef HAVE_SYSTEM
  register char *shell;
  shell = (char *) getenv ("SHELL");
  if (shell == NULL)
    shell = "/bin/sh";
  /* CloseStreams(TRUE); */
  if (system (shell) < 0) {
#if HAVE_STRERROR
    Error(SYSTEM_ERROR, TermNil, 
	"sh: %s", strerror(errno));
#else
    Error(SYSTEM_ERROR, TermNil,
	  "sh");
#endif
    return (FALSE);
  }
  return (TRUE);
#else
#ifdef MSH
  register char *shell;
  shell = "msh -i";
  /* CloseStreams(); */
  system (shell);
  return (TRUE);
#else
  Error(SYSTEM_ERROR,TermNil,"sh not available in this configuration");
  return(FALSE);
#endif /* MSH */
#endif
}

static Int
p_shell (void)
{				/* '$shell'(+SystCommand)			 */
#if _MSC_VER || defined(__MINGW32__)
   return(0);
#else
#if HAVE_SYSTEM 
  char *shell;
  char *command = AllocTmpSpaceFromGlobal();
  register int bourne = FALSE;
  Term t1 = Deref (ARG1);

  if (!GetName (command, t1)) {
    Error(SYSTEM_ERROR,t1,"invalid argument to shell/1");
    return(FALSE);
  }
  shell = (char *) getenv ("SHELL");
  if (!strcmp (shell, "/bin/sh"))
    bourne = TRUE;
  if (shell == NIL)
    bourne = TRUE;
  /* CloseStreams(TRUE); */
  if (bourne)
    return (system (command) == 0);
  else
    {
      int status = -1;
      int child = fork ();
      if (child == 0)
	{			/* let the children go */
	  execl (shell, shell, "-c", command, NIL);
	  exit (TRUE);
	}
      {				/* put the father on wait */
	int result = child < 0 ||
/* vsc:I am not sure this is used, Stevens say wait returns an integer.
#if NO_UNION_WAIT
*/
	wait ((&status)) != child ||
/*
#else
	wait ((union wait *) (&status)) != child ||
#endif
*/
	status == 0;
	return (result);
      }
    }
#else /* HAVE_SYSTEM */
#ifdef MSH
  register char *shell;
  shell = "msh -i";
  /* CloseStreams(); */
  system (shell);
  return (TRUE);
#else
  Error (SYSTEM_ERROR,TermNil,"shell not available in this configuration");
  return(FALSE);
#endif
#endif /* HAVE_SYSTEM */
#endif /* _MSC_VER */
}

static Int
p_system (void)
{				/* '$system'(+SystCommand)	       */
#ifdef HAVE_SYSTEM
  char *command = AllocTmpSpaceFromGlobal();
  Term t1 = Deref (ARG1);
  if (!GetName (command, t1)) {
    Error(SYSTEM_ERROR,t1,"argument to system/1 is not valid");
    return(FALSE);
  }
  /* CloseStreams(TRUE); */
#if _MSC_VER
  _flushall();
#endif
  return (system (command) == 0);
#else
#ifdef MSH
  register char *shell;
  shell = "msh -i";
  /* CloseStreams(); */
  system (shell);
  return (TRUE);
#else
  Error(SYSTEM_ERROR,TermNil,"sh not available in this machine");
  return(FALSE);
#endif
#endif /* HAVE_SYSTEM */
}



/* Rename a file */
static Int
p_mv (void)
{				/* rename(+OldName,+NewName)   */
#if HAVE_LINK
  int r;
  char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX];
  Term t1 = Deref (ARG1);
  Term t2 = Deref (ARG2);
  if (!GetName (FileNameBuf, t1)) {
    Error(SYSTEM_ERROR,t1,"first argument to rename/2 is not valid");
    return(FALSE);
  }
  TrueFileName (FileNameBuf, oldname, FALSE);
  if (!GetName (FileNameBuf, t2)) {
    Error(SYSTEM_ERROR,t2,"second argument to rename/2 is not valid");
    return(FALSE);
  }
  TrueFileName (FileNameBuf, newname, FALSE);
  if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
    unlink (newname);
  if (r != 0) {
    Error(SYSTEM_ERROR,t2,"operating system error in rename/2");
    return(FALSE);
  }
  return (TRUE);
#else
  Error(SYSTEM_ERROR,TermNil,"rename/2 not available in this machine");
  return (FALSE);
#endif
}


/* Change the working directory */
static Int
p_cd (void)
{				/* cd(+NewD)			 */
#if HAVE_CHDIR
  Term t1 = Deref (ARG1);
  if (t1 == TermNil)
    return(TRUE);
  if (!GetName (FileNameBuf, t1)) {
    Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid");
    return(FALSE);
  }
  TrueFileName (FileNameBuf, FileNameBuf2, FALSE);
  return (!chdir (FileNameBuf2));
#else
#ifdef MACYAP
  Term t1 = Deref (ARG1);
  if (!GetName (FileNameBuf, t1)) {
    Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid");
    return(FALSE);
  }
  TrueFileName (FileNameBuf, FileNameBuf2, FALSE);
  return (!chdir (FileNameBuf2));
#else
  Error(SYSTEM_ERROR,TermNil,"cd/1 not available in this machine");
  return(FALSE);
#endif
#endif
}

#ifdef MAC

void
SetTextFile (name)
     char *name;
{
#ifdef MACC
  SetFileType (name, 'TEXT');
  SetFileSignature (name, 'EDIT');
#else
  FInfo f;
  FInfo *p = &f;
  GetFInfo (name, 0, p);
  p->fdType = 'TEXT';
#ifdef MPW
  if (mpwshell)
    p->fdCreator = 'MPS\0';
#endif
#ifndef LIGHT
  else
    p->fdCreator = 'EDIT';
#endif
  SetFInfo (name, 0, p);
#endif
}

#endif

/* return YAP's environment */
static Int p_environ(void)
{
#if HAVE_ENVIRON
  extern char **environ;
  Term t1 = Deref(ARG1);
  Int i;

  if (IsVarTerm(t1)) {
    Error(INSTANTIATION_ERROR, t1,
	  "first arg of environ/2");
    return(FALSE);
  } else if (!IsIntTerm(t1)) {
    Error(TYPE_ERROR_INTEGER, t1,
	  "first arg of environ/2");
    return(FALSE);
  } else i = IntOfTerm(t1);
  if (environ[i] == NULL)
    return(FALSE);
  else {
    Term t = StringToList(environ[i]);
    return(unify(t, ARG2));
  }
#else
    Error(SYSTEM_ERROR, TermNil,
	  "environ not available in this configuration");
    return (FALSE);
#endif
}

/* return YAP's environment */
static Int p_getenv(void)
{
#if HAVE_GETENV
  Term t1 = Deref(ARG1), to;
  char *s, *so;

  if (IsVarTerm(t1)) {
    Error(INSTANTIATION_ERROR, t1,
	  "first arg of getenv/2");
    return(FALSE);
  } else if (!IsAtomTerm(t1)) {
    Error(TYPE_ERROR_ATOM, t1,
	  "first arg of getenv/2");
    return(FALSE);
  } else s = RepAtom(AtomOfTerm(t1))->StrOfAE;
  if ((so = getenv(s)) == NULL)
    return(FALSE);
  to = MkAtomTerm(LookupAtom(so));
  return(unify_constant(ARG2,to));
#else
    Error(SYSTEM_ERROR, TermNil,
	  "getenv not available in this configuration");
    return (FALSE);
#endif
}

/* set a variable in YAP's environment */
static Int p_putenv(void)
{
#if HAVE_PUTENV
  Term t1 = Deref(ARG1), t2 = Deref(ARG2);
  char *s, *s2, *p0, *p;

  if (IsVarTerm(t1)) {
    Error(INSTANTIATION_ERROR, t1,
	  "first arg to putenv/2");
    return(FALSE);
  } else if (!IsAtomTerm(t1)) {
    Error(TYPE_ERROR_ATOM, t1,
	  "first arg to putenv/2");
    return(FALSE);
  } else s = RepAtom(AtomOfTerm(t1))->StrOfAE;
  if (IsVarTerm(t2)) {
    Error(INSTANTIATION_ERROR, t1,
	  "second arg to putenv/2");
    return(FALSE);
  } else if (!IsAtomTerm(t2)) {
    Error(TYPE_ERROR_ATOM, t2,
	  "second arg to putenv/2");
    return(FALSE);
  } else s2 = RepAtom(AtomOfTerm(t2))->StrOfAE;
  p0 = p = AllocAtomSpace(strlen(s)+strlen(s2)+3);
  while ((*p++ = *s++) != '\0');
  p[-1] = '=';
  while ((*p++ = *s2++) != '\0');
  if (putenv(p0) == 0)
    return(TRUE);
#if HAVE_STRERROR
  Error(SYSTEM_ERROR, TermNil,
	"putenv: %s", strerror(errno));
#else
  Error(SYSTEM_ERROR, TermNil,
	"putenv");
#endif
  return (FALSE);
#else
    Error(SYSTEM_ERROR, TermNil,
	  "putenv not available in this configuration");
    return (FALSE);
#endif
}


/* wrapper for alarm system call */
#if defined(_WIN32)
static VOID CALLBACK HandleTimer(LPVOID v, DWORD d1, DWORD d2) {
  /* force the system to creep */
  p_creep ();
  /* now, say what is going on */
  PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
}
#endif

static Int
p_alarm(void)
{
  Term t = Deref(ARG1);
  if (IsVarTerm(t)) {
    Error(INSTANTIATION_ERROR, t, "alarm/2");
    return(FALSE);
  }
  if (!IsIntegerTerm(t)) {
    Error(TYPE_ERROR_INTEGER, t, "alarm/2");
    return(FALSE);
  }
#if _MSC_VER || defined(__MINGW32__)
  {
    Term tout;
    HANDLE htimer = CreateWaitableTimer(NULL,FALSE,NULL);
    LARGE_INTEGER due_time;
    __int64 timeout = -IntegerOfTerm(t);
    due_time.QuadPart =  timeout;

    if (SetWaitableTimer(htimer, &due_time,0,HandleTimer,NULL,TRUE) == 0) {
	  Error(SYSTEM_ERROR, TermNil,
			 "alarm not available in this configuration");
      return(FALSE);
	}
    tout = MkIntegerTerm(0);
    return(unify(ARG2,tout));
  }
#elif HAVE_ALARM
  {
    Int left;
    Term tout;

    left = alarm(IntOfTerm(t));
    tout = MkIntegerTerm(left);
    return(unify(ARG2,tout));
  }
#else
  Error(SYSTEM_ERROR, TermNil,
	"alarm not available in this configuration");
  return(FALSE);
#endif
}

#if HAVE_FPU_CONTROL_H
#include <fpu_control.h>
#endif

/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */
void
set_fpu_exceptions(int flag)
{
  if (flag) {
#if defined(__hpux)
    fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL);
#endif
#if HAVE_FPU_CONTROL_H && i386 && FIX_CONFIGURE
    /* I shall ignore denormalization and precision errors */
    int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM);
    _FPU_SETCW(v);
#endif
#if HAVE_FETESTEXCEPT
    feclearexcept(FE_ALL_EXCEPT);
#endif
  } else {
    /* do IEEE arithmetic in the way the big boys do */
#if defined(__hpux)
    fpsetmask(FP_X_CLEAR);
#endif
#if HAVE_FPU_CONTROL_H && i386 && FIX_CONFIGURE
    /* this will probably not work in older releases of Linux */
    int v = _FPU_IEEE;
   _FPU_SETCW(v);
#endif    
  }
}

/*
 * This is responsable for the initialization of all machine dependant
 * predicates
 */
void
InitSysbits (void)
{
  InitPageSize();
  InitTime ();
  InitWTime ();
  InitRandom ();
  /* let the caller control signals as it sees fit */
  InitSignals ();
}

void
ReInitWallTime (void)
{
  InitWTime();
  if (heap_regs->last_wtime != NULL) 
    FreeCodeSpace(heap_regs->last_wtime);
  InitLastWtime();
}

void
InitSysPreds(void)
{
  /* can only do after heap is initialised */
  InitLastWtime();
  InitCPred ("srandom", 1, p_srandom, SafePredFlag);
  InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
  InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag);
  InitCPred ("$system", 1, p_system, SafePredFlag|SyncPredFlag);
  InitCPred ("$rename", 2, p_mv, SafePredFlag|SyncPredFlag);
  InitCPred ("$cd", 1, p_cd, SafePredFlag|SyncPredFlag);
  InitCPred ("$getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag);
  InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag);
  InitCPred ("$environ", 2, p_environ, SafePredFlag);
  InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
  InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
  InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
}


#ifdef VAX

/* avoid longjmp botch */

int vax_absmi_fp;

typedef struct
  {
    int eh;
    int flgs;
    int ap;
    int fp;
    int pc;
    int dummy1;
    int dummy2;
    int dummy3;
    int oldfp;
    int dummy4;
    int dummy5;
    int dummy6;
    int oldpc;
  }

 *VaxFramePtr;


VaxFixFrame (dummy)
{
  int maxframes = 100;
  VaxFramePtr fp = (VaxFramePtr) (((int *) &dummy) - 6);
  while (--maxframes)
    {
      fp = (VaxFramePtr) fp->fp;
      if (fp->flgs == 0)
	{
	  if (fp->oldfp >= &REGS[6] && fp->oldfp < &REGS[REG_SIZE])
	    fp->oldfp = vax_absmi_fp;
	  return;
	}
    }
}

#endif


#ifdef _WIN32

int WINAPI STD_PROTO(win_yap, (HANDLE, DWORD, LPVOID));

int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved)
{
  switch (reason) 
    {
    case DLL_PROCESS_ATTACH:
      break;
    case DLL_PROCESS_DETACH:
      break;
    case DLL_THREAD_ATTACH:
      break;
    case DLL_THREAD_DETACH:
      break;
    }
  return 1;
}
#endif