From e3a56234e471f3f175a6b98c6285f663b37c3949 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 5 Nov 2015 16:47:11 +0000 Subject: [PATCH] big sys split --- os/sysbits.c | 1939 +------------------------------------------------- 1 file changed, 12 insertions(+), 1927 deletions(-) diff --git a/os/sysbits.c b/os/sysbits.c index e17d4a786..506183e4c 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -19,95 +19,7 @@ static char SccsId[] = "%W% %G%"; #endif -// @{ - -/** - @addtogroup YAPOS -*/ - -/* - * routines. These include, for the moment : Time, A rudimentary form of - * signal handling, OS calls, - * - * Vitor Santos Costa, February 1987 - * - */ - -/* windows.h does not like absmi.h, this - should fix it for now */ -#if _WIN32 || __MINGW32__ -#include -#endif -#include "absmi.h" -#include "yapio.h" -#include "alloc.h" -#include -#if STDC_HEADERS -#include -#endif -#if HAVE_WINDOWS_H -#include -#endif -#if HAVE_SYS_TIME_H && !_MSC_VER -#include -#endif -#if HAVE_UNISTD_H -#include -#endif -#if HAVE_SYS_WAIT_H && !defined(__MINGW32__) && !_MSC_VER -#include -#endif -#if HAVE_STRING_H -#include -#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 -#endif -#include -#if HAVE_SYS_STAT_H -#include -#endif -#if HAVE_SYS_TYPES_H -#include -#endif -#if HAVE_FCNTL_H -#include -#endif -#if _MSC_VER || defined(__MINGW32__) -#include -/* required for DLL compatibility */ -#if HAVE_DIRECT_H -#include -#endif -#include -#include -#else -#if HAVE_SYS_PARAM_H -#include -#endif -#endif -/* CYGWIN seems to include this automatically */ -#if HAVE_FENV_H && !defined(__CYGWIN__) -#include -#endif -#if defined(ENABLE_SYSTEM_EXPANSION) && HAVE_WORDEXP_H -#include -#endif -#if HAVE_LIBGEN_H -#include -#endif -#if HAVE_STDARG_H -#include -#endif -#if HAVE_READLINE_READLINE_H -#include -#endif +#include "sysbits.h" /// File Error Handler static void @@ -127,18 +39,13 @@ Yap_FileError(yap_error_number type, Term where, const char *format,...) -static void InitTime(int); -static void InitWTime(void); static Int p_sh( USES_REGS1 ); static Int p_shell( USES_REGS1 ); static Int p_system( USES_REGS1 ); static Int p_mv( USES_REGS1 ); static Int p_dir_sp( USES_REGS1 ); -static void InitRandom(void); -static Int p_alarm( USES_REGS1 ); static Int p_getenv( USES_REGS1 ); static Int p_putenv( USES_REGS1 ); -static bool set_fpu_exceptions(Term); static char *expandVars(const char *pattern, char *expanded, int maxlen); #ifdef MACYAP static int chdir(char *); @@ -469,58 +376,6 @@ expandVars(const char *pattern, char *expanded, int maxlen) { return yapExpandVars(pattern, expanded); -#if ( __WIN32 || __MINGW32__ ) && defined(ENABLE_SYSTEM_EXPANSION) - DWORD retval=0; - // notice that the file does not need to exist - if (ini == NULL) { - ini = malloc(strlen(w)+1); - } - retval = ExpandEnvironmentStrings(pattern, - expanded, - maxlen); - - if (retval == 0) - { - Yap_WinError("Generating a full path name for a file" ); - return NULL; - } - return expanded; -#elif HAVE_WORDEXP && defined(ENABLE_SYSTEM_EXPANSION) - wordexp_t result; - - /* Expand the string for the program to run. */ - switch (wordexp (pattern, &result, 0)) - { - case 0: /* Successful. */ - if (result.we_wordv[1]) { - wordfree (&result); - return NULL; - } else { - char *w = result.we_wordv[0]; - if (expanded == NULL) { - expanded = malloc(strlen(w)+1); - } - strncpy( expanded, w, maxlen ); - wordfree (&result); - return expanded; - } - break; - case WRDE_NOSPACE: - /* If the error was WRDE_NOSPACE, - then perhaps part of the result was allocated. */ - wordfree (&result); - default: /* Some other error. */ - return NULL; - } -#else - // just use basic - if (expanded == NULL) { - expanded = malloc(strlen(pattern)+1); - } - strcpy(expanded, pattern); - -#endif - return expanded; } #if _WIN32 || defined(__MINGW32__) @@ -761,6 +616,7 @@ static char *canoniseFileName( char *path) { } */ + static Int absolute_file_name( USES_REGS1 ) { @@ -1048,1333 +904,6 @@ Yap_InitPageSize(void) #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 -#endif -#if HAVE_SYS_RESOURCE_H -#include -#endif - -#if THREADS -#define StartOfTimes (*(LOCAL_ThreadHandle.start_of_timesp)) -#define last_time (*(LOCAL_ThreadHandle.last_timep)) - -#define StartOfTimes_sys (*(LOCAL_ThreadHandle.start_of_times_sysp)) -#define last_time_sys (*(LOCAL_ThreadHandle.last_time_sysp)) - -#else -/* since the point YAP was started */ -static struct timeval StartOfTimes; - -/* since last call to runtime */ -static struct timeval last_time; - -/* same for system time */ -static struct timeval last_time_sys; -static struct timeval StartOfTimes_sys; -#endif - -/* store user time in this variable */ -static void -InitTime (int wid) -{ - struct rusage rusage; - -#if THREADS - REMOTE_ThreadHandle(wid).start_of_timesp = (struct timeval *)malloc(sizeof(struct timeval)); - REMOTE_ThreadHandle(wid).last_timep = (struct timeval *)malloc(sizeof(struct timeval)); - REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct timeval *)malloc(sizeof(struct timeval)); - REMOTE_ThreadHandle(wid).last_time_sysp = (struct timeval *)malloc(sizeof(struct timeval)); - getrusage(RUSAGE_SELF, &rusage); - (*REMOTE_ThreadHandle(wid).last_timep).tv_sec = - (*REMOTE_ThreadHandle(wid).start_of_timesp).tv_sec = - rusage.ru_utime.tv_sec; - (*REMOTE_ThreadHandle(wid).last_timep).tv_usec = - (*REMOTE_ThreadHandle(wid).start_of_timesp).tv_usec = - rusage.ru_utime.tv_usec; - (*REMOTE_ThreadHandle(wid).last_time_sysp).tv_sec = - (*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_sec = - rusage.ru_stime.tv_sec; - (*REMOTE_ThreadHandle(wid).last_time_sysp).tv_usec = - (*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_usec = - rusage.ru_stime.tv_usec; -#else - 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; - last_time_sys.tv_sec = - StartOfTimes_sys.tv_sec = - rusage.ru_stime.tv_sec; - last_time_sys.tv_usec = - StartOfTimes_sys.tv_usec = - rusage.ru_stime.tv_usec; -#endif -} - - -UInt -Yap_cputime ( void ) -{ - CACHE_REGS - 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 Yap_cputime_interval(Int *now,Int *interval) -{ - CACHE_REGS - 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; -} - -void Yap_systime_interval(Int *now,Int *interval) -{ - CACHE_REGS - struct rusage rusage; - - getrusage(RUSAGE_SELF, &rusage); - *now = (rusage.ru_stime.tv_sec - StartOfTimes_sys.tv_sec) * 1000 + - (rusage.ru_stime.tv_usec - StartOfTimes_sys.tv_usec) / 1000; - *interval = (rusage.ru_stime.tv_sec - last_time_sys.tv_sec) * 1000 + - (rusage.ru_stime.tv_usec - last_time_sys.tv_usec) / 1000; - last_time_sys.tv_usec = rusage.ru_stime.tv_usec; - last_time_sys.tv_sec = rusage.ru_stime.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 - - static FILETIME StartOfTimes, last_time; - -static FILETIME StartOfTimes_sys, last_time_sys; - -static clock_t TimesStartOfTimes, Times_last_time; - -/* store user time in this variable */ -static void -InitTime (int wid) -{ - HANDLE hProcess = GetCurrentProcess(); - FILETIME CreationTime, ExitTime, KernelTime, UserTime; - if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) { - /* WIN98 */ - clock_t t; - t = clock (); - Times_last_time = TimesStartOfTimes = t; - } else { -#if THREADS - REMOTE_ThreadHandle(wid).start_of_timesp = (struct _FILETIME *)malloc(sizeof(FILETIME)); - REMOTE_ThreadHandle(wid).last_timep = (struct _FILETIME *)malloc(sizeof(FILETIME)); - REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME)); - REMOTE_ThreadHandle(wid).last_time_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME)); - (*REMOTE_ThreadHandle(wid).last_timep).dwLowDateTime = - UserTime.dwLowDateTime; - (*REMOTE_ThreadHandle(wid).last_timep).dwHighDateTime = - UserTime.dwHighDateTime; - (*REMOTE_ThreadHandle(wid).start_of_timesp).dwLowDateTime = - UserTime.dwLowDateTime; - (*REMOTE_ThreadHandle(wid).start_of_timesp).dwHighDateTime = - UserTime.dwHighDateTime; - (*REMOTE_ThreadHandle(wid).last_time_sysp).dwLowDateTime = - KernelTime.dwLowDateTime; - (*REMOTE_ThreadHandle(wid).last_time_sysp).dwHighDateTime = - KernelTime.dwHighDateTime; - (*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwLowDateTime = - KernelTime.dwLowDateTime; - (*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwHighDateTime = - KernelTime.dwHighDateTime; -#else - last_time.dwLowDateTime = - UserTime.dwLowDateTime; - last_time.dwHighDateTime = - UserTime.dwHighDateTime; - StartOfTimes.dwLowDateTime = - UserTime.dwLowDateTime; - StartOfTimes.dwHighDateTime = - UserTime.dwHighDateTime; - last_time_sys.dwLowDateTime = - KernelTime.dwLowDateTime; - last_time_sys.dwHighDateTime = - KernelTime.dwHighDateTime; - StartOfTimes_sys.dwLowDateTime = - KernelTime.dwLowDateTime; - StartOfTimes_sys.dwHighDateTime = - KernelTime.dwHighDateTime; -#endif - } -} - -#ifdef __GNUC__ -static unsigned long long int -sub_utime(FILETIME t1, FILETIME t2) -{ - ULARGE_INTEGER u[2]; - memcpy((void *)u,(void *)&t1,sizeof(FILETIME)); - memcpy((void *)(u+1),(void *)&t2,sizeof(FILETIME)); - return - u[0].QuadPart - u[1].QuadPart; -} -#endif - -UInt -Yap_cputime ( void ) -{ - HANDLE hProcess = GetCurrentProcess(); - FILETIME CreationTime, ExitTime, KernelTime, UserTime; - if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) { - clock_t t; - t = clock (); - return(((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC); - } else { -#ifdef __GNUC__ - unsigned long long int t = - sub_utime(UserTime,StartOfTimes); - do_div(t,10000); - return((Int)t); -#endif -#ifdef _MSC_VER - __int64 t = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes; - return((Int)(t/10000)); -#endif - } -} - -void Yap_cputime_interval(Int *now,Int *interval) -{ - HANDLE hProcess = GetCurrentProcess(); - FILETIME CreationTime, ExitTime, KernelTime, UserTime; - if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) { - clock_t t; - t = clock (); - *now = ((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC; - *interval = (t - Times_last_time) * 1000 / CLOCKS_PER_SEC; - Times_last_time = t; - } else { -#ifdef __GNUC__ - unsigned long long int t1 = - sub_utime(UserTime, StartOfTimes); - unsigned long long int t2 = - sub_utime(UserTime, last_time); - do_div(t1,10000); - *now = (Int)t1; - do_div(t2,10000); - *interval = (Int)t2; -#endif -#ifdef _MSC_VER - __int64 t1 = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes; - __int64 t2 = *(__int64 *)&UserTime - *(__int64 *)&last_time; - *now = (Int)(t1/10000); - *interval = (Int)(t2/10000); -#endif - last_time.dwLowDateTime = UserTime.dwLowDateTime; - last_time.dwHighDateTime = UserTime.dwHighDateTime; - } -} - -void Yap_systime_interval(Int *now,Int *interval) -{ - HANDLE hProcess = GetCurrentProcess(); - FILETIME CreationTime, ExitTime, KernelTime, UserTime; - if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) { - *now = *interval = 0; /* not available */ - } else { -#ifdef __GNUC__ - unsigned long long int t1 = - sub_utime(KernelTime, StartOfTimes_sys); - unsigned long long int t2 = - sub_utime(KernelTime, last_time_sys); - do_div(t1,10000); - *now = (Int)t1; - do_div(t2,10000); - *interval = (Int)t2; -#endif -#ifdef _MSC_VER - __int64 t1 = *(__int64 *)&KernelTime - *(__int64 *)&StartOfTimes_sys; - __int64 t2 = *(__int64 *)&KernelTime - *(__int64 *)&last_time_sys; - *now = (Int)(t1/10000); - *interval = (Int)(t2/10000); -#endif - last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime; - last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime; - } -} - -#elif HAVE_TIMES - -#if defined(_WIN32) - -#include - -#define TicksPerSec CLOCKS_PER_SEC - -#else - -#if HAVE_SYS_TIMES_H -#include -#endif - -#endif - -#if defined(__sun__) && (defined(__svr4__) || defined(__SVR4)) - -#if HAVE_LIMITS_H -#include -#endif - -#define TicksPerSec CLK_TCK -#endif - -#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__) || defined(__DragonFly__) - -#if HAVE_TIME_H -#include -#endif - -#define TicksPerSec sysconf(_SC_CLK_TCK) - -#endif - -#if !TMS_IN_SYS_TIME -#if HAVE_SYS_TIMES_H -#include -#endif -#endif - -static clock_t StartOfTimes, last_time; - -static clock_t StartOfTimes_sys, last_time_sys; - -/* store user time in this variable */ -static void -InitTime (void) -{ - struct tms t; - times (&t); - (*REMOTE_ThreadHandle(wid).last_timep) = StartOfTimes = t.tms_utime; - last_time_sys = StartOfTimes_sys = t.tms_stime; -} - -UInt -Yap_cputime (void) -{ - struct tms t; - times(&t); - return((t.tms_utime - StartOfTimes)*1000 / TicksPerSec); -} - -void Yap_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; -} - -void Yap_systime_interval(Int *now,Int *interval) -{ - struct tms t; - times (&t); - *now = ((t.tms_stime - StartOfTimes_sys)*1000) / TicksPerSec; - *interval = (t.tms_stime - last_time_sys) * 1000 / TicksPerSec; - last_time_sys = t.tms_stime; -} - -#else /* HAVE_TIMES */ - -#ifdef SIMICS - -#include - -/* 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 (int wid) -{ - struct timeval tp; - - gettimeofday(&tp,NULL); - (*REMOTE_ThreadHandle(wid).last_timep).tv_sec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec; - (*REMOTE_ThreadHandle(wid).last_timep).tv_usec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec; -} - - -UInt -Yap_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 Yap_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; -} - -void Yap_systime_interval(Int *now,Int *interval) -{ - *now = *interval = 0; /* not available */ -} - -#endif /* SIMICS */ - -#ifdef COMMENTED_OUT -/* This code is not working properly. I left it here to help future ports */ -#ifdef MPW - -#include -#include - -#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 -#include - -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 - -#define TicksPerSec 60.0 - -static double -real_cputime () -{ - return (((double) TickCount ()) / TicksPerSec); -} - -#endif /* LIGHT */ - -#endif /* COMMENTED_OUT */ - -#endif /* HAVE_GETRUSAGE */ - -#if HAVE_GETHRTIME - -#if HAVE_TIME_H -#include -#endif - -/* since the point YAP was started */ -static hrtime_t StartOfWTimes; - -/* since last call to walltime */ -#define LastWtime (*(hrtime_t *)ALIGN_BY_TYPE(GLOBAL_LastWtimePtr,hrtime_t)) - -static void -InitWTime (void) -{ - StartOfWTimes = gethrtime(); -} - -static void -InitLastWtime(void) { - /* ask for twice the space in order to guarantee alignment */ - GLOBAL_LastWtimePtr = (void *)Yap_AllocCodeSpace(2*sizeof(hrtime_t)); - LastWtime = StartOfWTimes; -} - -Int -Yap_walltime (void) -{ - hrtime_t tp = gethrtime(); - /* return time in milliseconds */ - return((Int)((tp-StartOfWTimes)/((hrtime_t)1000000))); - -} - -void Yap_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 *)GLOBAL_LastWtimePtr) - -/* store user time in this variable */ -static void -InitWTime (void) -{ - gettimeofday(&StartOfWTimes,NULL); -} - -static void -InitLastWtime(void) { - GLOBAL_LastWtimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval)); - LastWtime.tv_usec = StartOfWTimes.tv_usec; - LastWtime.tv_sec = StartOfWTimes.tv_sec; -} - - -Int -Yap_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 Yap_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 -#include - -/* since the point YAP was started */ -static struct _timeb StartOfWTimes; - -/* since last call to walltime */ -#define LastWtime (*(struct timeb *)GLOBAL_LastWtimePtr) - -/* store user time in this variable */ -static void -InitWTime (void) -{ - _ftime(&StartOfWTimes); -} - -static void -InitLastWtime(void) { - GLOBAL_LastWtimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeb)); - LastWtime.time = StartOfWTimes.time; - LastWtime.millitm = StartOfWTimes.millitm; -} - - -Int -Yap_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 Yap_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 *)GLOBAL_LastWtimePtr) - -/* store user time in this variable */ -static void -InitWTime (void) -{ - StartOfWTimes = times(NULL); -} - -static void -InitLastWtime(void) { - GLOBAL_LastWtimePtr = (void *)Yap_AllocCodeSpace(sizeof(clock_t)); - LastWtime = StartOfWTimes; -} - -Int -Yap_walltime (void) -{ - clock_t t; - t = times(NULL); - return ((t - StartOfWTimes)*1000 / TicksPerSec)); -} - -void Yap_walltime_interval(Int *now,Int *interval) -{ - clock_t t; - t = times(NULL); - *now = ((t - StartOfWTimes)*1000) / TicksPerSec; - *interval = (t - GLOBAL_LastWtime) * 1000 / TicksPerSec; -} - -#endif /* HAVE_TIMES */ - -#if HAVE_TIME_H -#include -#endif - -unsigned int current_seed; - -static void -InitRandom (void) -{ - current_seed = (unsigned int) time (NULL); -#if HAVE_SRAND48 - srand48 (current_seed); -#elif HAVE_SRANDOM - srandom (current_seed); -#elif HAVE_SRAND - srand (current_seed); -#endif -} - -extern int rand(void); - - -double -Yap_random (void) -{ -#if HAVE_DRAND48 - return drand48(); -#elif HAVE_RANDOM - /* extern long random (); */ - return (((double) random ()) / 0x7fffffffL /* 2**31-1 */); -#elif HAVE_RAND - return (((double) (rand ()) / RAND_MAX)); -#else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "random not available in this configuration"); - return (0.0); -#endif -} - -#if HAVE_RANDOM -static Int -p_init_random_state ( USES_REGS1 ) -{ - register Term t0 = Deref (ARG1); - char *old, *new; - - if (IsVarTerm (t0)) { - return(Yap_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); - - new = (char *) malloc(256); - old = initstate(random(), new, 256); - return Yap_unify(ARG2, MkIntegerTerm((Int)old)) && - Yap_unify(ARG3, MkIntegerTerm((Int)new)); -} - -static Int -p_set_random_state ( USES_REGS1 ) -{ - register Term t0 = Deref (ARG1); - char *old, * new; - - if (IsVarTerm (t0)) { - return FALSE; - } - if (IsIntegerTerm (t0)) - new = (char *) IntegerOfTerm (t0); - else - return FALSE; - old = setstate( new ); - return Yap_unify(ARG2, MkIntegerTerm((Int)old)); -} - -static Int -p_release_random_state ( USES_REGS1 ) -{ - register Term t0 = Deref (ARG1); - char *old; - - if (IsVarTerm (t0)) { - return FALSE; - } - if (IsIntegerTerm (t0)) - old = (char *) IntegerOfTerm (t0); - else - return FALSE; - free( old ); - return TRUE; -} -#endif - -static Int -Srandom ( USES_REGS1 ) -{ - register Term t0 = Deref (ARG1); - if (IsVarTerm (t0)) { - return(Yap_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_SRAND48 - srand48(current_seed); -#elif HAVE_SRANDOM - srandom(current_seed); -#elif HAVE_SRAND - srand(current_seed); - -#endif - return (TRUE); -} - -#if HAVE_SIGNAL_H - -#include - -#ifdef MPW -#define signal sigset -#endif - - -#ifdef MSH - -#define SIGFPE SIGDIV - -#endif - -static void InitSignals(void); - -#define PLSIG_PREPARED 0x01 /* signal is prepared */ -#define PLSIG_THROW 0x02 /* throw signal(num, name) */ -#define PLSIG_SYNC 0x04 /* call synchronously */ -#define PLSIG_NOFRAME 0x08 /* Do not create a Prolog frame */ - -#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */ - -#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0) -#ifdef ATOMGC -#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1) -#endif -#define SIG_GC (SIG_PROLOG_OFFSET+2) -#ifdef THREADS -#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+3) -#endif -#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4) -#define SIG_PLABORT (SIG_PROLOG_OFFSET+5) - -static struct signame -{ int sig; - const char *name; - int flags; -} signames[] = - { -#ifdef SIGHUP - { SIGHUP, "hup", 0}, -#endif - { SIGINT, "int", 0}, -#ifdef SIGQUIT - { SIGQUIT, "quit", 0}, -#endif - { SIGILL, "ill", 0}, - { SIGABRT, "abrt", 0}, -#if HAVE_SIGFPE - { SIGFPE, "fpe", PLSIG_THROW}, -#endif -#ifdef SIGKILL - { SIGKILL, "kill", 0}, -#endif - { SIGSEGV, "segv", 0}, -#ifdef SIGPIPE - { SIGPIPE, "pipe", 0}, -#endif -#ifdef SIGALRM - { SIGALRM, "alrm", PLSIG_THROW}, -#endif - { SIGTERM, "term", 0}, -#ifdef SIGUSR1 - { SIGUSR1, "usr1", 0}, -#endif -#ifdef SIGUSR2 - { SIGUSR2, "usr2", 0}, -#endif -#ifdef SIGCHLD - { SIGCHLD, "chld", 0}, -#endif -#ifdef SIGCONT - { SIGCONT, "cont", 0}, -#endif -#ifdef SIGSTOP - { SIGSTOP, "stop", 0}, -#endif -#ifdef SIGTSTP - { SIGTSTP, "tstp", 0}, -#endif -#ifdef SIGTTIN - { SIGTTIN, "ttin", 0}, -#endif -#ifdef SIGTTOU - { SIGTTOU, "ttou", 0}, -#endif -#ifdef SIGTRAP - { SIGTRAP, "trap", 0}, -#endif -#ifdef SIGBUS - { SIGBUS, "bus", 0}, -#endif -#ifdef SIGSTKFLT - { SIGSTKFLT, "stkflt", 0}, -#endif -#ifdef SIGURG - { SIGURG, "urg", 0}, -#endif -#ifdef SIGIO - { SIGIO, "io", 0}, -#endif -#ifdef SIGPOLL - { SIGPOLL, "poll", 0}, -#endif -#ifdef SIGXCPU - { SIGXCPU, "xcpu", PLSIG_THROW}, -#endif -#ifdef SIGXFSZ - { SIGXFSZ, "xfsz", PLSIG_THROW}, -#endif -#ifdef SIGVTALRM - { SIGVTALRM, "vtalrm", PLSIG_THROW}, -#endif -#ifdef SIGPROF - { SIGPROF, "prof", 0}, -#endif -#ifdef SIGPWR - { SIGPWR, "pwr", 0}, -#endif - { SIG_EXCEPTION, "prolog:exception", 0 }, -#ifdef SIG_ATOM_GC - { SIG_ATOM_GC, "prolog:atom_gc", 0 }, -#endif - { SIG_GC, "prolog:gc", 0 }, -#ifdef SIG_THREAD_SIGNAL - { SIG_THREAD_SIGNAL, "prolog:thread_signal", 0 }, -#endif - - { -1, NULL, 0} - }; - -/* SWI emulation */ -int -Yap_signal_index(const char *name) -{ struct signame *sn = signames; - char tmp[12]; - - if ( strncmp(name, "SIG", 3) == 0 && strlen(name) < 12 ) - { char *p = (char *)name+3, *q = tmp; - while ((*q++ = tolower(*p++))) {}; - name = tmp; - } - - for( ; sn->name; sn++ ) - { if ( !strcmp(sn->name, name) ) - return sn->sig; - } - - return -1; -} - -#if HAVE_SIGINFO_H -#include -#endif -#if HAVE_SYS_UCONTEXT_H -#include -#endif - -#if HAVE_SIGSEGV -static void -SearchForTrailFault(void *ptr, int sure) -{ - - /* 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 - */ -#if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC - if ((ptr > (void *)LOCAL_TrailTop-1024 && - TR < (tr_fr_ptr) LOCAL_TrailTop+(64*1024))) { - if (!Yap_growtrail(64*1024, TRUE)) { - Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, "YAP failed to reserve %ld bytes in growtrail", K64); - } - /* just in case, make sure the OS keeps the signal handler. */ - /* my_signal_info(SIGSEGV, HandleSIGSEGV); */ - } else -#endif /* OS_HANDLES_TR_OVERFLOW */ - if (sure) - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, - "tried to access illegal address %p!!!!", ptr); - else - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, - "likely bug in YAP, segmentation violation"); -} - - -/* This routine believes there is a continuous space starting from the - HeapBase and ending on TrailTop */ -static void -HandleSIGSEGV(int sig, void *sipv, void *uap) -{ - CACHE_REGS - - void *ptr = TR; - int sure = FALSE; - if (LOCAL_PrologMode & ExtendStackMode) { - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, "OS memory allocation crashed at address %p, bailing out\n",LOCAL_TrailTop); - } -#if (defined(__svr4__) || defined(__SVR4)) - siginfo_t *sip = sipv; - if ( - sip->si_code != SI_NOINFO && - sip->si_code == SEGV_MAPERR) { - ptr = sip->si_addr; - sure = TRUE; - } -#elif __linux__ - siginfo_t *sip = sipv; - ptr = sip->si_addr; - sure = TRUE; -#endif - SearchForTrailFault( ptr, sure ); -} -#endif /* SIGSEGV */ - -yap_error_number -Yap_MathException__( USES_REGS1 ) -{ -#if HAVE_FETESTEXCEPT - int raised; - - // #pragma STDC FENV_ACCESS ON - if ((raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) { - - feclearexcept(FE_ALL_EXCEPT); - if (raised & FE_OVERFLOW) { - return EVALUATION_ERROR_FLOAT_OVERFLOW; - } else if (raised & FE_DIVBYZERO) { - return EVALUATION_ERROR_ZERO_DIVISOR; - } else if (raised & FE_UNDERFLOW) { - return EVALUATION_ERROR_FLOAT_UNDERFLOW; - //} else if (raised & (FE_INVALID|FE_INEXACT)) { - // return EVALUATION_ERROR_UNDEFINED; - } else { - return EVALUATION_ERROR_UNDEFINED; - } - } -#elif _WIN32 && FALSE - unsigned int raised; - int err; - - // Show original FP control word and do calculation. - err = _controlfp_s(&raised, 0, 0); - if (err) { - return EVALUATION_ERROR_UNDEFINED; - } - if (raised ) { - feclearexcept(FE_ALL_EXCEPT); - if (raised & FE_OVERFLOW) { - return EVALUATION_ERROR_FLOAT_OVERFLOW; - } else if (raised & FE_DIVBYZERO) { - return EVALUATION_ERROR_ZERO_DIVISOR; - } else if (raised & FE_UNDERFLOW) { - return EVALUATION_ERROR_FLOAT_UNDERFLOW; - //} else if (raised & (FE_INVALID|FE_INEXACT)) { - // return EVALUATION_ERROR_UNDEFINED; - } else { - return EVALUATION_ERROR_UNDEFINED; - } - } -#elif (defined(__svr4__) || defined(__SVR4)) - switch(sip->si_code) { - case FPE_INTDIV: - return EVALUATION_ERROR_ZERO_DIVISOR; - break; - case FPE_INTOVF: - return EVALUATION_ERROR_INT_OVERFLOW; - break; - case FPE_FLTDIV: - return EVALUATION_ERROR_ZERO_DIVISOR; - break; - case FPE_FLTOVF: - return EVALUATION_ERROR_FLOAT_OVERFLOW; - break; - case FPE_FLTUND: - return EVALUATION_ERROR_FLOAT_UNDERFLOW; - break; - case FPE_FLTRES: - case FPE_FLTINV: - case FPE_FLTSUB: - default: - return EVALUATION_ERROR_UNDEFINED; - } - set_fpu_exceptions(0); -#endif - - return LOCAL_matherror; -} - -static Int -p_fpe_error( USES_REGS1 ) -{ - Yap_Error(LOCAL_matherror, LOCAL_mathtt, LOCAL_mathstring); - LOCAL_matherror = YAP_NO_ERROR; - LOCAL_mathtt = TermNil; - LOCAL_mathstring = NULL; - return FALSE; -} - -#if HAVE_SIGFPE -static void -HandleMatherr(int sig, void *sipv, void *uapv) -{ - CACHE_REGS - LOCAL_matherror = Yap_MathException( ); - /* reset the registers so that we don't have trash in abstract machine */ - Yap_external_signal( worker_id, YAP_FPE_SIGNAL ); -} - -#endif /* SIGFPE */ - - - -typedef void (*signal_handler_t)(int, void *, void *); - -#if HAVE_SIGACTION -static void -my_signal_info(int sig, void * handler) -{ - struct sigaction sigact; - - sigact.sa_handler = handler; - sigemptyset(&sigact.sa_mask); - sigact.sa_flags = SA_SIGINFO; - - sigaction(sig,&sigact,NULL); -} - -static void -my_signal(int sig, void * handler) -{ - struct sigaction sigact; - - sigact.sa_handler= (void *)handler; - sigemptyset(&sigact.sa_mask); - sigact.sa_flags = 0; - sigaction(sig,&sigact,NULL); -} - -#else - -static void -my_signal(int sig, void *handler) -{ - signal(sig, handler); -} - -static void -my_signal_info(int sig, void *handler) -{ - if(signal(sig, (void *)handler) == SIG_ERR) - exit(1); -} - -#endif - -#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT) -static RETSIGTYPE -ReceiveSignal (int s, void *x, void *y) -{ - CACHE_REGS - LOCAL_PrologMode |= InterruptMode; - my_signal (s, ReceiveSignal); - switch (s) - { - case SIGINT: - // always direct SIGINT to console - Yap_external_signal( 0, YAP_INT_SIGNAL ); - break; - case SIGALRM: - Yap_external_signal( worker_id, YAP_ALARM_SIGNAL ); - break; - case SIGVTALRM: - Yap_external_signal( worker_id, YAP_VTALARM_SIGNAL ); - break; -#ifndef MPW -#ifdef HAVE_SIGFPE - case SIGFPE: - Yap_external_signal( worker_id, YAP_FPE_SIGNAL ); - break; -#endif -#endif -#if !defined(LIGHT) && !defined(_WIN32) - /* These signals are not handled by WIN32 and not the Macintosh */ - case SIGQUIT: - case SIGKILL: - LOCAL_PrologMode &= ~InterruptMode; - Yap_Error(INTERRUPT_EVENT,MkIntTerm(s),NULL); - break; -#endif -#ifdef SIGUSR1 - case SIGUSR1: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_USR1_SIGNAL); - break; -#endif /* defined(SIGUSR1) */ -#ifdef SIGUSR2 - case SIGUSR2: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_USR2_SIGNAL); - break; -#endif /* defined(SIGUSR2) */ -#ifdef SIGPIPE - case SIGPIPE: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_PIPE_SIGNAL); - break; -#endif /* defined(SIGPIPE) */ -#ifdef SIGHUP - case SIGHUP: - /* force the system to creep */ - /* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */ - break; -#endif /* defined(SIGHUP) */ - default: - fprintf(stderr, "\n[ Unexpected signal ]\n"); - exit (s); - } - LOCAL_PrologMode &= ~InterruptMode; -} -#endif - -#if (_MSC_VER || defined(__MINGW32__)) -static BOOL WINAPI -MSCHandleSignal(DWORD dwCtrlType) { -#if THREADS - if (REMOTE_InterruptsDisabled(0)) { -#else - if (LOCAL_InterruptsDisabled) { -#endif - return FALSE; - } - switch(dwCtrlType) { - case CTRL_C_EVENT: - case CTRL_BREAK_EVENT: -#if THREADS - Yap_external_signal(0, YAP_WINTIMER_SIGNAL); - REMOTE_PrologMode(0) |= InterruptMode; -#else - Yap_signal(YAP_WINTIMER_SIGNAL); - LOCAL_PrologMode |= InterruptMode; -#endif - return(TRUE); - default: - return(FALSE); - } - } -#endif - - - /* SIGINT can cause problems, if caught before full initialization */ - static void - InitSignals (void) - { - if (GLOBAL_PrologShouldHandleInterrupts) { -#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT) - my_signal (SIGQUIT, ReceiveSignal); - my_signal (SIGKILL, ReceiveSignal); - my_signal (SIGUSR1, ReceiveSignal); - my_signal (SIGUSR2, ReceiveSignal); - my_signal (SIGHUP, ReceiveSignal); - my_signal (SIGALRM, ReceiveSignal); - my_signal (SIGVTALRM, ReceiveSignal); -#endif -#ifdef SIGPIPE - my_signal (SIGPIPE, ReceiveSignal); -#endif -#if _MSC_VER || defined(__MINGW32__) - signal (SIGINT, SIG_IGN); - SetConsoleCtrlHandler(MSCHandleSignal,TRUE); -#else - my_signal (SIGINT, ReceiveSignal); -#endif -#ifdef HAVE_SIGFPE - my_signal (SIGFPE, HandleMatherr); -#endif -#if HAVE_SIGSEGV - my_signal_info (SIGSEGV, HandleSIGSEGV); -#endif -#ifdef YAPOR_COW - signal(SIGCHLD, SIG_IGN); /* avoid ghosts */ -#endif - } - } - -#endif /* HAVE_SIGNAL */ /* TrueFileName -> Finds the true name of a file */ @@ -3058,264 +1587,6 @@ MSCHandleSignal(DWORD dwCtrlType) { #endif - static Int - p_alarm( USES_REGS1 ) - { - Term t = Deref(ARG1); - Term t2 = Deref(ARG2); - Int i1, i2; - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); - return(FALSE); - } - i1 = IntegerOfTerm(t); - i2 = IntegerOfTerm(t2); - if (i1 == 0 && i2 == 0) { -#if _WIN32 - Yap_get_signal( YAP_WINTIMER_SIGNAL ); -#else - Yap_get_signal( YAP_ALARM_SIGNAL ); -#endif - } -#if _MSC_VER || defined(__MINGW32__) - { - Term tout; - Int time[2]; - - time[0] = i1; - time[1] = i2; - - if (time[0] != 0 && time[1] != 0) { - DWORD dwThreadId; - HANDLE hThread; - - hThread = CreateThread( - NULL, /* no security attributes */ - 0, /* use default stack size */ - DoTimerThread, /* thread function */ - (LPVOID)time, /* argument to thread function */ - 0, /* use default creation flags */ - &dwThreadId); /* returns the thread identifier */ - - /* Check the return value for success. */ - if (hThread == NULL) { - Yap_WinError("trying to use alarm"); - } - } - tout = MkIntegerTerm(0); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)); - } -#elif HAVE_SETITIMER && !SUPPORT_CONDOR - { - struct itimerval new, old; - - new.it_interval.tv_sec = 0; - new.it_interval.tv_usec = 0; - new.it_value.tv_sec = i1; - new.it_value.tv_usec = i2; - if (setitimer(ITIMER_REAL, &new, &old) < 0) { -#if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", strerror(errno)); -#else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); -#endif - return FALSE; - } - return Yap_unify(ARG3,MkIntegerTerm(old.it_value.tv_sec)) && - Yap_unify(ARG4,MkIntegerTerm(old.it_value.tv_usec)); - } -#elif HAVE_ALARM && !SUPPORT_CONDOR - { - Int left; - Term tout; - - left = alarm(i1); - tout = MkIntegerTerm(left); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)) ; - } -#else - /* not actually trying to set the alarm */ - if (IntegerOfTerm(t) == 0) - return TRUE; - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "alarm not available in this configuration"); - return FALSE; -#endif - } - - static Int - p_virtual_alarm( USES_REGS1 ) - { - Term t = Deref(ARG1); - Term t2 = Deref(ARG2); - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); - return(FALSE); - } -#if _MSC_VER || defined(__MINGW32__) - { - Term tout; - Int time[2]; - - time[0] = IntegerOfTerm(t); - time[1] = IntegerOfTerm(t2); - - if (time[0] != 0 && time[1] != 0) { - DWORD dwThreadId; - HANDLE hThread; - - hThread = CreateThread( - NULL, /* no security attributes */ - 0, /* use default stack size */ - DoTimerThread, /* thread function */ - (LPVOID)time, /* argument to thread function */ - 0, /* use default creation flags */ - &dwThreadId); /* returns the thread identifier */ - - /* Check the return value for success. */ - if (hThread == NULL) { - Yap_WinError("trying to use alarm"); - } - } - tout = MkIntegerTerm(0); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)); - } -#elif HAVE_SETITIMER && !SUPPORT_CONDOR - { - struct itimerval new, old; - - new.it_interval.tv_sec = 0; - new.it_interval.tv_usec = 0; - new.it_value.tv_sec = IntegerOfTerm(t); - new.it_value.tv_usec = IntegerOfTerm(t2); - if (setitimer(ITIMER_VIRTUAL, &new, &old) < 0) { -#if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", strerror(errno)); -#else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); -#endif - return FALSE; - } - return Yap_unify(ARG3,MkIntegerTerm(old.it_value.tv_sec)) && - Yap_unify(ARG4,MkIntegerTerm(old.it_value.tv_usec)); - } -#else - /* not actually trying to set the alarm */ - if (IntegerOfTerm(t) == 0) - return TRUE; - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "virtual_alarm not available in this configuration"); - return FALSE; -#endif - } - -#if HAVE_FPU_CONTROL_H -#include -#endif - - /* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */ - static bool - set_fpu_exceptions(Term flag) - { - if (flag == TermTrue) { -#if HAVE_FESETEXCEPTFLAG - fexcept_t excepts; - return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0; -#elif HAVE_FEENABLEEXCEPT - /* I shall ignore de-normalization and precision errors */ - feenableexcept(FE_DIVBYZERO| FE_INVALID|FE_OVERFLOW); -#elif _WIN32 - // Enable zero-divide, overflow and underflow exception - _controlfp_s(0, ~(_EM_ZERODIVIDE|_EM_UNDERFLOW|_EM_OVERFLOW), _MCW_EM); // Line B -#elif defined(__hpux) -# if HAVE_FESETTRAPENABLE - /* From HP-UX 11.0 onwards: */ - fesettrapenable(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW); -# else - /* - Up until HP-UX 10.20: - FP_X_INV invalid operation exceptions - FP_X_DZ divide-by-zero exception - FP_X_OFL overflow exception - FP_X_UFL underflow exception - FP_X_IMP imprecise (inexact result) - FP_X_CLEAR simply zero to clear all flags - */ - fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL); -# endif -#endif /* __hpux */ -#if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) - /* 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 -#ifdef HAVE_SIGFPE - my_signal (SIGFPE, HandleMatherr); -#endif - } else { - /* do IEEE arithmetic in the way the big boys do */ -#if HAVE_FESETEXCEPTFLAG - fexcept_t excepts; - return fesetexceptflag(&excepts, 0) == 0; -#elif HAVE_FEENABLEEXCEPT - /* I shall ignore de-normalization and precision errors */ - feenableexcept(0); -#elif _WIN32 - // Enable zero-divide, overflow and underflow exception - _controlfp_s(0, (_EM_ZERODIVIDE|_EM_UNDERFLOW|_EM_OVERFLOW), _MCW_EM); // Line B -#elif defined(__hpux) -# if HAVE_FESETTRAPENABLE - fesettrapenable(FE_ALL_EXCEPT); -# else - fpsetmask(FP_X_CLEAR); -# endif -#endif /* __hpux */ -#if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) - /* this will probably not work in older releases of Linux */ - int v = _FPU_IEEE; - _FPU_SETCW(v); -#endif -#ifdef HAVE_SIGFPE - my_signal (SIGFPE, SIG_IGN); -#endif - } - return true; - } - - bool - Yap_set_fpu_exceptions(Term flag) - { - return set_fpu_exceptions(flag); - } - - static Int p_host_type( USES_REGS1 ) { Term out = MkAtomTerm(Yap_LookupAtom(HOST_ALIAS)); @@ -3402,31 +1673,17 @@ MSCHandleSignal(DWORD dwCtrlType) { void Yap_InitSysbits (void) { + CACHE_REGS #if __simplescalar__ { char *pwd = getenv("PWD"); strncpy(GLOBAL_pwd,pwd,YAP_FILENAME_MAX); } #endif - InitWTime (); - InitRandom (); + Yap_InitWTime (); + Yap_InitRandom (); /* let the caller control signals as it sees fit */ - InitSignals (); - } - - void - Yap_InitTime( int wid ) - { - InitTime( wid ); - } - - void - Yap_ReInitWallTime (void) - { - InitWTime(); - if (Yap_global->LastWtimePtr_ != NULL) - Yap_FreeCodeSpace(Yap_global->LastWtimePtr_); - InitLastWtime(); + Yap_InitOSSignals (worker_id); } static Int @@ -3462,26 +1719,6 @@ MSCHandleSignal(DWORD dwCtrlType) { } - static Int - p_enable_interrupts( USES_REGS1 ) - { - LOCAL_InterruptsDisabled--; - if (LOCAL_Signals && !LOCAL_InterruptsDisabled) { - CreepFlag = Unsigned(LCL0); - if ( !Yap_only_has_signal( YAP_CREEP_SIGNAL ) ) - EventFlag = Unsigned( LCL0 ); - } - return TRUE; - } - - static Int - p_disable_interrupts( USES_REGS1 ) - { - LOCAL_InterruptsDisabled++; - CalculateStackGap( PASS_REGS1 ); - return TRUE; - } - static Int p_ld_path( USES_REGS1 ) { @@ -3700,17 +1937,6 @@ MSCHandleSignal(DWORD dwCtrlType) { Yap_InitSysPreds(void) { CACHE_REGS - Term cm = CurrentModule; - - /* can only do after heap is initialised */ - InitLastWtime(); - Yap_InitCPred ("srandom", 1, Srandom, SafePredFlag); -#if HAVE_RANDOM - Yap_InitCPred ("init_random_state", 3, p_init_random_state, SafePredFlag); - Yap_InitCPred ("set_random_state", 2, p_set_random_state, SafePredFlag); - Yap_InitCPred ("release_random_state", 1, p_release_random_state, SafePredFlag); -#endif - Yap_InitCPred ("$absolute_file_name", 2, absolute_file_name, SafePredFlag|SyncPredFlag); Yap_InitCPred ("log_event", 1, p_log_event, SafePredFlag|SyncPredFlag); Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag); @@ -3722,7 +1948,6 @@ MSCHandleSignal(DWORD dwCtrlType) { Yap_InitCPred ("libraries_directories",2, libraries_directories, 0); Yap_InitCPred ("system_library", 1, system_library, 0); Yap_InitCPred ("commons_library", 1, commons_library, 0); - Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag); Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag); @@ -3734,155 +1959,15 @@ MSCHandleSignal(DWORD dwCtrlType) { Yap_InitCPred ("$expand_file_name", 2, p_expand_file_name, SyncPredFlag); Yap_InitCPred ("working_directory", 2,working_directory, SyncPredFlag); Yap_InitCPred ("prolog_to_os_filename", 2, prolog_to_os_filename, SyncPredFlag); - Yap_InitCPred ("$fpe_error", 0, p_fpe_error, 0); + Yap_InitCPred ("prolog_to_os_filename", 2, prolog_to_os_filename, SyncPredFlag); #ifdef _WIN32 Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0); #endif - CurrentModule = HACKS_MODULE; - Yap_InitCPred ("virtual_alarm", 4, p_virtual_alarm, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("enable_interrupts", 0, p_enable_interrupts, SafePredFlag); - Yap_InitCPred ("disable_interrupts", 0, p_disable_interrupts, SafePredFlag); - CurrentModule = OPERATING_SYSTEM_MODULE; - Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag); - Yap_InitCPred ("true_file_name", 3, p_true_file_name3, SyncPredFlag); + Yap_InitCPred ("absolute_file_name", 2, absolute_file_name, 0); + Yap_InitCPred ("true_file_name", 2, + true_file_name, SyncPredFlag); + Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag); Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag); - CurrentModule = cm; Yap_InitCPred ("make_directory", 1, make_directory, 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 >= ®S[6] && fp->oldfp < ®S[REG_SIZE]) - fp->oldfp = vax_absmi_fp; - return; - } - } - } - -#endif - - -#if defined(_WIN32) - -#include - - int WINAPI 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 - -#if (defined(YAPOR) || defined(THREADS)) && !defined(USE_PTHREAD_LOCKING) -#ifdef sparc - void rw_lock_voodoo(void); - - void - rw_lock_voodoo(void) { - /* code taken from the Linux kernel, it handles shifting between locks */ - /* Read/writer locks, as usual this is overly clever to make it as fast as possible. */ - /* caches... */ - __asm__ __volatile__( - "___rw_read_enter_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_read_enter\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_read_enter_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - "___rw_read_exit_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_read_exit\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_read_exit_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - "___rw_write_enter_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_write_enter\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_write_enter_spin_on_wlock\n" - " ld [%g1], %g2\n" - "\n" - " .globl ___rw_read_enter\n" - "___rw_read_enter:\n" - " orcc %g2, 0x0, %g0\n" - " bne,a ___rw_read_enter_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - " ld [%g1], %g2\n" - " add %g2, 1, %g2\n" - " st %g2, [%g1]\n" - " retl\n" - " mov %g4, %o7\n" - " .globl ___rw_read_exit\n" - "___rw_read_exit:\n" - " orcc %g2, 0x0, %g0\n" - " bne,a ___rw_read_exit_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - " ld [%g1], %g2\n" - " sub %g2, 0x1ff, %g2\n" - " st %g2, [%g1]\n" - " retl\n" - " mov %g4, %o7\n" - " .globl ___rw_write_enter\n" - "___rw_write_enter:\n" - " orcc %g2, 0x0, %g0\n" - " bne ___rw_write_enter_spin_on_wlock\n" - " ld [%g1], %g2\n" - " andncc %g2, 0xff, %g0\n" - " bne,a ___rw_write_enter_spin_on_wlock\n" - " stb %g0, [%g1 + 3]\n" - " retl\n" - " mov %g4, %o7\n" - ); - } -#endif /* sparc */ - - -#endif /* YAPOR || THREADS */ - - //@ +