diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

SWI portability

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-01-16 12:28:37 +00:00
parent 1bba29c646
commit 7cf4e9442c
6 changed files with 224 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
H/pl-incl.h
View File

@ -937,6 +937,8 @@ COMMON(word) pl_get_prolog_flag(term_t key, term_t value);
COMMON(word) pl_prolog_flag5(term_t key, term_t value, word scope, word access, word type, control_t h); COMMON(word) pl_prolog_flag5(term_t key, term_t value, word scope, word access, word type, control_t h);
COMMON(foreign_t) pl_prolog_flag(term_t name, term_t value, control_t h); COMMON(foreign_t) pl_prolog_flag(term_t name, term_t value, control_t h);
COMMON(struct tm *) PL_localtime_r(const time_t *t, struct tm *r);
/* inlines that need ARG_LD */ /* inlines that need ARG_LD */
static inline intptr_t static inline intptr_t
skip_list(Word l, Word *tailp ARG_LD) { skip_list(Word l, Word *tailp ARG_LD) {

116
os/pl-cstack.c
View File

@ -89,15 +89,49 @@ get_trace_store(void)
} }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
next_btrace_id() produces the id for the next backtrace and sets
bt->current to the subsequent id. Although bt is thread-local, it may be
called from a signal handler or (Windows) exception. We cannot use
locking because the mutex functions are not async signal safe. So, we
use atomic instructions if possible. Otherwise, we ensure consistency of
the datastructures, but we may overwrite an older stack trace.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
void void
save_backtrace(const char *why) save_backtrace(const char *why)
{ btrace *bt = get_trace_store(); { btrace *bt = get_trace_store();
if ( bt ) if ( bt )
{ btrace_stack *s = &bt->dumps[bt->current]; { btrace_stack *s;
unw_cursor_t cursor; unw_context_t uc; unw_cursor_t cursor; unw_context_t uc;
int depth; int depth;
int current = next_btrace_id(bt);
s = &bt->dumps[current];
unw_getcontext(&uc); unw_getcontext(&uc);
unw_init_local(&cursor, &uc); unw_init_local(&cursor, &uc);
for(depth=0; unw_step(&cursor) > 0 && depth < MAX_DEPTH; depth++) for(depth=0; unw_step(&cursor) > 0 && depth < MAX_DEPTH; depth++)
@ -107,9 +141,6 @@ save_backtrace(const char *why)
} }
s->name = why; s->name = why;
s->depth = depth; s->depth = depth;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
} }
} }
@ -228,6 +259,33 @@ get_trace_store(void)
} }
/* Copy of same function above. Relies on a different btrace structure.
Ideally, this should be shared :-(
*/
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
void void
save_backtrace(const char *why) save_backtrace(const char *why)
{ btrace *bt = get_trace_store(); { btrace *bt = get_trace_store();
@ -235,15 +293,14 @@ save_backtrace(const char *why)
if ( bt ) if ( bt )
{ void *array[100]; { void *array[100];
size_t frames; size_t frames;
int current = next_btrace_id(bt);
frames = backtrace(array, sizeof(array)/sizeof(void *)); frames = backtrace(array, sizeof(array)/sizeof(void *));
bt->sizes[bt->current] = frames; bt->sizes[current] = frames;
if ( bt->symbols[bt->current] ) if ( bt->symbols[current] )
free(bt->symbols[bt->current]); free(bt->symbols[current]);
bt->symbols[bt->current] = backtrace_symbols(array, frames); bt->symbols[current] = backtrace_symbols(array, frames);
bt->why[bt->current] = why; bt->why[current] = why;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
} }
} }
@ -358,6 +415,9 @@ initBackTrace(void)
*/ */
#define MAX_MODULE_NAME_LENGTH 64 #define MAX_MODULE_NAME_LENGTH 64
#define LOCK() PL_LOCK(L_CSTACK)
#define UNLOCK() PL_UNLOCK(L_CSTACK)
typedef struct typedef struct
{ char name[MAX_FUNCTION_NAME_LENGTH]; /* function called */ { char name[MAX_FUNCTION_NAME_LENGTH]; /* function called */
DWORD64 offset; /* offset in function */ DWORD64 offset; /* offset in function */
@ -397,6 +457,32 @@ get_trace_store(void)
return LD->btrace_store; return LD->btrace_store;
} }
/* Copy of same function above. Relies on a different btrace structure.
Ideally, this should be shared :-(
*/
static int
next_btrace_id(btrace *bt)
{ int current;
#ifdef COMPARE_AND_SWAP
int next;
do
{ current = bt->current;
next = current+1;
if ( next == SAVE_TRACES )
next = 0;
} while ( !COMPARE_AND_SWAP(&bt->current, current, next) );
#else
current = bt->current++ % SAVE_TRACES;
if ( bt->current >= SAVE_TRACES )
bt->current %= SAVE_TRACES;
#endif
return current;
}
int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo) int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
{ STACKFRAME64 frame; { STACKFRAME64 frame;
CONTEXT context; CONTEXT context;
@ -406,7 +492,6 @@ int backtrace(btrace_stack* trace, PEXCEPTION_POINTERS pExceptionInfo)
char symbolScratch[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LEN]; char symbolScratch[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LEN];
SYMBOL_INFO* symbol = (SYMBOL_INFO*)&symbolScratch; SYMBOL_INFO* symbol = (SYMBOL_INFO*)&symbolScratch;
IMAGEHLP_MODULE64 moduleInfo; IMAGEHLP_MODULE64 moduleInfo;
EXCEPTION_POINTERS *pExp = NULL;
DWORD64 offset; DWORD64 offset;
DWORD imageType; DWORD imageType;
int skip = 0; int skip = 0;
@ -529,11 +614,12 @@ void
win_save_backtrace(const char *why, PEXCEPTION_POINTERS pExceptionInfo) win_save_backtrace(const char *why, PEXCEPTION_POINTERS pExceptionInfo)
{ btrace *bt = get_trace_store(); { btrace *bt = get_trace_store();
if ( bt ) if ( bt )
{ btrace_stack *s = &bt->dumps[bt->current]; { int current = next_btrace_id(bt);
btrace_stack *s = &bt->dumps[current];
LOCK();
s->depth = backtrace(s, pExceptionInfo); s->depth = backtrace(s, pExceptionInfo);
UNLOCK();
s->name = why; s->name = why;
if ( ++bt->current == SAVE_TRACES )
bt->current = 0;
} }
} }

2
os/pl-prologflag.c
View File

@ -1273,7 +1273,9 @@ cleanupPrologFlags(void)
{ Table t = GD->prolog_flag.table; { Table t = GD->prolog_flag.table;
GD->prolog_flag.table = NULL; GD->prolog_flag.table = NULL;
#ifdef O_PLMT
t->free_symbol = freeSymbolPrologFlagTable; t->free_symbol = freeSymbolPrologFlagTable;
#endif
destroyHTable(t); destroyHTable(t);
} }
} }

4
os/pl-table.c
View File

@ -173,7 +173,11 @@ rehashHTable(Table ht, Symbol map)
{ Symbol *newentries, *oldentries; { Symbol *newentries, *oldentries;
int newbuckets, oldbuckets; int newbuckets, oldbuckets;
int i; int i;
#ifdef O_PLMT
int safe_copy = (ht->mutex != NULL); int safe_copy = (ht->mutex != NULL);
#else
int safe_copy = TRUE;
#endif
newbuckets = ht->buckets*2; newbuckets = ht->buckets*2;
newentries = allocHTableEntries(newbuckets); newentries = allocHTableEntries(newbuckets);

2
os/pl-table.h
View File

@ -19,7 +19,7 @@
You should have received a copy of the GNU Lesser General Public You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/ */
#ifndef TABLE_H_INCLUDED #ifndef TABLE_H_INCLUDED

162
os/pl-tai.c
View File

@ -1,11 +1,9 @@
/* $Id$ /* Part of SWI-Prolog
Part of SWI-Prolog
Author: Jan Wielemaker Author: Jan Wielemaker
E-mail: J.Wielemaker@cs.vu.nl E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org WWW: http://www.swi-prolog.org
Copyright (C): 1985-2010, University of Amsterdam Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam VU University Amsterdam
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
@ -20,17 +18,10 @@
You should have received a copy of the GNU Lesser General Public You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/ */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #define __MINGW_USE_VC2005_COMPAT /* Get Windows time_t as 64-bit */
Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS
is supposed to give the POSIX standard one.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#if defined(__sun__) || defined(__sun)
#define _POSIX_PTHREAD_SEMANTICS 1
#endif
#include <math.h> #include <math.h>
#include "pl-incl.h" #include "pl-incl.h"
@ -62,37 +53,6 @@ extern long timezone;
#endif #endif
#endif #endif
#if defined(__MINGW32__)
#include <stdlib.h>
#include <time.h>
#include <string.h>
#ifndef localtime_r
struct tm *localtime_r (const time_t *, struct tm *);
struct tm *
localtime_r (const time_t *timer, struct tm *result)
{
struct tm *local_result;
local_result = localtime (timer);
if (local_result == NULL || result == NULL)
return NULL;
memcpy (result, local_result, sizeof (result));
return result;
}
#endif
#ifndef asctime_r
#define asctime_r(_Tm, _Buf) ({ char *___tmp_tm = asctime((_Tm)); \
if (___tmp_tm) \
___tmp_tm = \
strcpy((_Buf),___tmp_tm);\
___tmp_tm; })
#endif
#endif
#define TAI_UTC_OFFSET LL(4611686018427387914) #define TAI_UTC_OFFSET LL(4611686018427387914)
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -102,6 +62,8 @@ struct ftm is a `floating' version of the system struct tm.
#define HAS_STAMP 0x0001 #define HAS_STAMP 0x0001
#define HAS_WYDAY 0x0002 #define HAS_WYDAY 0x0002
#define NO_UTC_OFFSET 0x7fffffff
typedef struct ftm typedef struct ftm
{ struct tm tm; /* System time structure */ { struct tm tm; /* System time structure */
double sec; /* float version of tm.tm_sec */ double sec; /* float version of tm.tm_sec */
@ -147,7 +109,7 @@ tz_offset(void)
{ time_t t = time(NULL); { time_t t = time(NULL);
struct tm tm; struct tm tm;
localtime_r(&t, &tm); PL_localtime_r(&t, &tm);
offset = -tm.tm_gmtoff; offset = -tm.tm_gmtoff;
if ( tm.tm_isdst > 0 ) if ( tm.tm_isdst > 0 )
@ -177,7 +139,7 @@ static atom_t
tz_name_as_atom(int dst) tz_name_as_atom(int dst)
{ static atom_t a[2]; { static atom_t a[2];
dst = (dst != 0); /* 0 or 1 */ dst = (dst > 0); /* 0 or 1 */
if ( !a[dst] ) if ( !a[dst] )
{ wchar_t wbuf[256]; { wchar_t wbuf[256];
@ -245,10 +207,12 @@ get_tz_arg(int i, term_t t, term_t a, atom_t *tz)
atom_t name; atom_t name;
_PL_get_arg(i, t, a); _PL_get_arg(i, t, a);
if ( !PL_get_atom_ex(a, &name) ) if ( !PL_is_variable(a) )
{ if ( !PL_get_atom_ex(a, &name) )
fail; fail;
if ( name != ATOM_minus ) if ( name != ATOM_minus )
*tz = name; *tz = name;
}
succeed; succeed;
} }
@ -264,6 +228,21 @@ get_int_arg(int i, term_t t, term_t a, int *val)
} }
static int
get_voff_arg(int i, term_t t, term_t a, int *val)
{ GET_LD
_PL_get_arg(i, t, a);
if ( PL_is_variable(a) )
{ *val = NO_UTC_OFFSET;
return TRUE;
} else
{ return PL_get_integer_ex(a, val);
}
}
static int static int
get_float_arg(int i, term_t t, term_t a, double *val) get_float_arg(int i, term_t t, term_t a, double *val)
{ GET_LD { GET_LD
@ -275,7 +254,7 @@ get_float_arg(int i, term_t t, term_t a, double *val)
static int static int
get_bool_arg(int i, term_t t, term_t a, int *val) get_dst_arg(int i, term_t t, term_t a, int *val)
{ GET_LD { GET_LD
atom_t name; atom_t name;
@ -284,10 +263,16 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
{ if ( name == ATOM_true ) { if ( name == ATOM_true )
{ *val = TRUE; { *val = TRUE;
return TRUE; return TRUE;
} else if ( name == ATOM_false || name == ATOM_minus ) } else if ( name == ATOM_false )
{ *val = FALSE; { *val = FALSE;
return TRUE; return TRUE;
} else if ( name == ATOM_minus )
{ *val = -1;
return TRUE;
} }
} else if ( PL_is_variable(a) )
{ *val = -2;
return TRUE;
} }
return PL_get_bool_ex(a, val); /* generate an error */ return PL_get_bool_ex(a, val); /* generate an error */
@ -297,23 +282,25 @@ get_bool_arg(int i, term_t t, term_t a, int *val)
static int static int
get_ftm(term_t t, ftm *ftm) get_ftm(term_t t, ftm *ftm)
{ GET_LD { GET_LD
term_t tmp = PL_new_term_ref();
if ( PL_is_functor(t, FUNCTOR_date9) ) int date9;
{ term_t tmp = PL_new_term_ref();
memset(ftm, 0, sizeof(*ftm)); memset(ftm, 0, sizeof(*ftm));
if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) && if ( (date9=PL_is_functor(t, FUNCTOR_date9)) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) && get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) && get_int_arg (3, t, tmp, &ftm->tm.tm_mday) &&
get_int_arg (4, t, tmp, &ftm->tm.tm_hour) && get_int_arg (4, t, tmp, &ftm->tm.tm_hour) &&
get_int_arg (5, t, tmp, &ftm->tm.tm_min) && get_int_arg (5, t, tmp, &ftm->tm.tm_min) &&
get_float_arg(6, t, tmp, &ftm->sec) && get_float_arg(6, t, tmp, &ftm->sec) &&
get_int_arg (7, t, tmp, &ftm->utcoff) && get_voff_arg (7, t, tmp, &ftm->utcoff) &&
get_tz_arg (8, t, tmp, &ftm->tzname) && get_tz_arg (8, t, tmp, &ftm->tzname) &&
get_bool_arg (9, t, tmp, &ftm->isdst) ) get_dst_arg (9, t, tmp, &ftm->isdst) )
{ double fp, ip; { double fp, ip;
ftm->tm.tm_isdst = (ftm->isdst == -2 ? -1 : ftm->isdst);
fixup: fixup:
fp = modf(ftm->sec, &ip); fp = modf(ftm->sec, &ip);
if ( fp < 0.0 ) if ( fp < 0.0 )
@ -325,20 +312,62 @@ get_ftm(term_t t, ftm *ftm)
ftm->tm.tm_year -= 1900; /* 1900 based */ ftm->tm.tm_year -= 1900; /* 1900 based */
ftm->tm.tm_mon--; /* 0-based */ ftm->tm.tm_mon--; /* 0-based */
if ( ftm->utcoff == NO_UTC_OFFSET )
{ if ( ftm->tm.tm_isdst < 0 ) /* unknown DST */
{ int offset;
if ( mktime(&ftm->tm) == (time_t)-1 )
return PL_representation_error("dst");
ftm->flags |= HAS_WYDAY;
offset = tz_offset();
if ( ftm->tm.tm_isdst > 0 )
offset -= 3600;
ftm->utcoff = offset;
if ( date9 ) /* variable */
{ _PL_get_arg(7, t, tmp);
if ( !PL_unify_integer(tmp, ftm->utcoff) )
return FALSE;
} else
{ ftm->utcoff = offset;
}
}
if ( ftm->isdst == -2 )
{ ftm->isdst = ftm->tm.tm_isdst;
_PL_get_arg(9, t, tmp);
if ( ftm->isdst < 0 )
{ if ( !PL_unify_atom(tmp, ATOM_minus) )
return FALSE;
} else
{ if ( !PL_unify_bool(tmp, ftm->isdst) )
return FALSE;
}
}
if ( !ftm->tzname )
{ ftm->tzname = tz_name_as_atom(ftm->isdst);
_PL_get_arg(8, t, tmp);
if ( PL_is_variable(tmp) &&
!PL_unify_atom(tmp, ftm->tzname) )
return FALSE;
}
}
succeed; succeed;
} }
} else if ( PL_is_functor(t, FUNCTOR_date3) ) } else if ( PL_is_functor(t, FUNCTOR_date3) )
{ term_t tmp = PL_new_term_ref(); { if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
memset(ftm, 0, sizeof(*ftm));
if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) && get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) ) get_int_arg (3, t, tmp, &ftm->tm.tm_mday) )
{ ftm->tm.tm_isdst = -1;
ftm->utcoff = NO_UTC_OFFSET;
goto fixup; goto fixup;
} }
}
fail; return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, t);
} }
@ -407,7 +436,7 @@ PRED_IMPL("stamp_date_time", 3, stamp_date_time, 0)
if ( (int64_t)unixt == ut64 ) if ( (int64_t)unixt == ut64 )
{ double ip; { double ip;
localtime_r(&unixt, &tm); PL_localtime_r(&unixt, &tm);
sec = (double)tm.tm_sec + modf(argsec, &ip); sec = (double)tm.tm_sec + modf(argsec, &ip);
ct.date.year = tm.tm_year+1900; ct.date.year = tm.tm_year+1900;
ct.date.month = tm.tm_mon+1; ct.date.month = tm.tm_mon+1;
@ -654,7 +683,6 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
case_b: case_b:
{ char fmt[3]; { char fmt[3];
char buf[256]; char buf[256];
size_t n;
fmt[0] = '%'; fmt[0] = '%';
fmt[1] = (char)c; fmt[1] = (char)c;
@ -662,7 +690,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
cal_ftm(ftm, HAS_STAMP|HAS_WYDAY); cal_ftm(ftm, HAS_STAMP|HAS_WYDAY);
/* conversion is not thread-safe under locale switch */ /* conversion is not thread-safe under locale switch */
n = strftime(buf, sizeof(buf), fmt, &ftm->tm); strftime(buf, sizeof(buf), fmt, &ftm->tm);
OUTSTRA(buf); OUTSTRA(buf);
break; break;
} }
@ -856,7 +884,7 @@ format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix)
{ char buf[26]; { char buf[26];
cal_ftm(ftm, HAS_WYDAY); cal_ftm(ftm, HAS_WYDAY);
asctime_r(&ftm->tm, buf); PL_asctime_r(&ftm->tm, buf);
buf[24] = EOS; buf[24] = EOS;
OUTSTRA(buf); OUTSTRA(buf);
} }
@ -920,7 +948,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
if ( (int64_t)unixt == ut64 ) if ( (int64_t)unixt == ut64 )
{ tb.utcoff = tz_offset(); { tb.utcoff = tz_offset();
localtime_r(&unixt, &tb.tm); PL_localtime_r(&unixt, &tb.tm);
tb.sec = (double)tb.tm.tm_sec + modf(tb.stamp, &ip); tb.sec = (double)tb.tm.tm_sec + modf(tb.stamp, &ip);
if ( tb.tm.tm_isdst > 0 ) if ( tb.tm.tm_isdst > 0 )
{ tb.utcoff -= 3600; { tb.utcoff -= 3600;
@ -942,7 +970,7 @@ pl_format_time(term_t out, term_t format, term_t time, int posix)
tb.utcoff = 0; tb.utcoff = 0;
} }
} else if ( !get_ftm(time, &tb) ) } else if ( !get_ftm(time, &tb) )
{ return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, time); { return FALSE;
} }
if ( !setupOutputRedirect(out, &ctx, FALSE) ) if ( !setupOutputRedirect(out, &ctx, FALSE) )