/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org Copyright (C): 1985-2007, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 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 #include "pl-incl.h" #include "libtai/taia.h" #include "libtai/caltime.h" #include #include #if defined(__WINDOWS__) || defined (__CYGWIN__) #define timezone _timezone #define HAVE_VAR_TIMEZONE #else extern char *tzname[2]; #ifdef HAVE_VAR_TIMEZONE extern long timezone; #endif #endif #define TAI_UTC_OFFSET LL(4611686018427387914) /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - struct ftm is a `floating' version of the system struct tm. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #define HAS_STAMP 0x0001 #define HAS_WYDAY 0x0002 typedef struct ftm { struct tm tm; /* System time structure */ double sec; /* float version of tm.tm_sec */ int utcoff; /* offset to UTC (seconds) */ atom_t tzname; /* Name of timezone */ int isdst; /* Daylight saving time */ double stamp; /* Time stamp (sec since 1970-1-1) */ int flags; /* Filled fields */ } ftm; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tz_offset() returns the offset from UTC in seconds. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static void do_tzset() { static int done = FALSE; if ( !done ) { tzset(); done = TRUE; } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - POSIX provides the variable timezone, providing the offset of the current timezone WEST of GMT in seconds. Some systems (FreeBSD) do not provide that. Instead thet provide tm_gmtoff in struct tm, but this value is EAST and includes the DST offset. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static int tz_offset() { #ifdef HAVE_VAR_TIMEZONE do_tzset(); return timezone; #else #ifdef HAVE_STRUCT_TIME_TM_GMTOFF static int offset = -1; if ( offset == -1 ) { time_t t = time(NULL); struct tm tm; localtime_r(&t, &tm); offset = -tm.tm_gmtoff; if ( tm.tm_isdst > 0 ) offset += 3600; /*Use to verify on systems where we know both. In Western Europe the offset must be -3600, both in winter and summer.*/ /*Sdprintf("timezone offset = %d (must be %d)\n", offset, timezone);*/ } return offset; #else #error "Do not know how to get timezone info" #endif #endif } static char * tz_name(int dst) { dst = (dst != 0); do_tzset(); return tzname[dst]; } static atom_t tz_name_as_atom(int dst) { static atom_t a[2]; dst = (dst != 0); /* 0 or 1 */ if ( !a[dst] ) { wchar_t wbuf[256]; const char *str = tz_name(dst); size_t n; if ( (n = mbstowcs(wbuf, str, sizeof(wbuf)/sizeof(wbuf[0])-1)) != (size_t)-1 ) { a[dst] = PL_new_atom_wchars(n, wbuf); } else { a[dst] = PL_new_atom(str); } } return a[dst]; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - unify_taia(): Unify a TAIA date as a Prolog double using the POSIX 1970 origin; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* static int unify_taia(term_t t, struct taia *taia) { double d = (double)((int64_t)taia->sec.x - TAI_UTC_OFFSET); d += taia->nano / 1e9; return PL_unify_float(t, d); } */ static int get_taia(term_t t, struct taia *taia, double *seconds) { double d; if ( PL_get_float(t, &d) ) { double fp, ip; if ( seconds ) *seconds = d; fp = modf(d, &ip); if ( fp < 0 ) { fp += 1.0; ip -= 1.0; } taia->sec.x = (int64_t)ip + TAI_UTC_OFFSET; taia->nano = (long)(fp*1e9); taia->atto = 0L; return TRUE; } return FALSE; } static int get_tz_arg(int i, term_t t, term_t a, atom_t *tz) { GET_LD atom_t name; _PL_get_arg(i, t, a); if ( !PL_get_atom_ex(a, &name) ) fail; if ( name != ATOM_minus ) *tz = name; succeed; } static int get_int_arg(int i, term_t t, term_t a, int *val) { GET_LD _PL_get_arg(i, t, a); return PL_get_integer_ex(a, val); } static int get_float_arg(int i, term_t t, term_t a, double *val) { GET_LD _PL_get_arg(i, t, a); return PL_get_float_ex(a, val); } static int get_bool_arg(int i, term_t t, term_t a, int *val) { GET_LD atom_t name; _PL_get_arg(i, t, a); if ( PL_get_atom(a, &name) ) { if ( name == ATOM_true ) { *val = TRUE; return TRUE; } else if ( name == ATOM_false || name == ATOM_minus ) { *val = FALSE; return TRUE; } } return PL_get_bool_ex(a, val); /* generate an error */ } static int get_ftm(term_t t, ftm *ftm) { GET_LD if ( PL_is_functor(t, FUNCTOR_date9) ) { term_t tmp = PL_new_term_ref(); 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 (3, t, tmp, &ftm->tm.tm_mday) && get_int_arg (4, t, tmp, &ftm->tm.tm_hour) && get_int_arg (5, t, tmp, &ftm->tm.tm_min) && get_float_arg(6, t, tmp, &ftm->sec) && get_int_arg (7, t, tmp, &ftm->utcoff) && get_tz_arg (8, t, tmp, &ftm->tzname) && get_bool_arg (9, t, tmp, &ftm->isdst) ) { double fp, ip; fixup: fp = modf(ftm->sec, &ip); if ( fp < 0.0 ) { fp += 1.0; ip -= 1.0; } ftm->tm.tm_sec = (int)ip; ftm->tm.tm_year -= 1900; /* 1900 based */ ftm->tm.tm_mon--; /* 0-based */ succeed; } } else if ( PL_is_functor(t, FUNCTOR_date3) ) { term_t tmp = PL_new_term_ref(); 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 (3, t, tmp, &ftm->tm.tm_mday) ) goto fixup; } fail; } /** void cal_ftm(ftm *ftm, int required) compute missing fields from fmt */ void cal_ftm(ftm *ftm, int required) { int missing = ftm->flags^required; if ( missing ) /* we need something, so we always */ { struct caltime ct; /* need the stamp */ struct tai tai; ct.date.year = ftm->tm.tm_year+1900; ct.date.month = ftm->tm.tm_mon+1; ct.date.day = ftm->tm.tm_mday; ct.hour = ftm->tm.tm_hour; ct.minute = ftm->tm.tm_min; ct.second = ftm->tm.tm_sec; ct.offset = -ftm->utcoff / 60; /* TBD: make libtai speak seconds */ caltime_tai(&ct, &tai); ftm->stamp = (double)((int64_t)tai.x - TAI_UTC_OFFSET); ftm->stamp -= (double)ct.second; ftm->stamp += ftm->sec; ftm->flags |= HAS_STAMP; if ( missing & HAS_WYDAY ) { caltime_utc(&ct, &tai, &ftm->tm.tm_wday, &ftm->tm.tm_yday); ftm->flags |= HAS_WYDAY; } } } static PRED_IMPL("stamp_date_time", 3, stamp_date_time, 0) { PRED_LD struct taia taia; term_t compound = A2; double argsec; if ( get_taia(A1, &taia, &argsec) ) { struct caltime ct; int weekday, yearday; double sec; int utcoffset; int done = FALSE; atom_t alocal; atom_t tzatom = ATOM_minus; atom_t dstatom = ATOM_minus; if ( PL_get_atom(A3, &alocal) ) { if ( alocal == ATOM_local ) { time_t unixt; int64_t ut64; struct tm tm; utcoffset = tz_offset(); ut64 = taia.sec.x - TAI_UTC_OFFSET; unixt = (time_t) ut64; if ( (int64_t)unixt == ut64 ) { double ip; localtime_r(&unixt, &tm); sec = (double)tm.tm_sec + modf(argsec, &ip); ct.date.year = tm.tm_year+1900; ct.date.month = tm.tm_mon+1; ct.date.day = tm.tm_mday; ct.hour = tm.tm_hour; ct.minute = tm.tm_min; tzatom = tz_name_as_atom(tm.tm_isdst); if ( tm.tm_isdst > 0 ) { utcoffset -= 3600; dstatom = ATOM_true; } else { dstatom = ATOM_false; } done = TRUE; } } else if ( alocal == ATOM_utc ) { utcoffset = 0; tzatom = alocal; } else { return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_timezone, A3); } } else if ( !PL_get_integer_ex(A3, &utcoffset) ) { fail; } if ( !done ) { taia.sec.x -= utcoffset; caltime_utc(&ct, &taia.sec, &weekday, &yearday); sec = (double)ct.second+(double)taia.nano/1e9; } return PL_unify_term(compound, PL_FUNCTOR, FUNCTOR_date9, PL_LONG, ct.date.year, PL_INT, ct.date.month, PL_INT, ct.date.day, PL_INT, ct.hour, PL_INT, ct.minute, PL_FLOAT, sec, PL_INT, utcoffset, PL_ATOM, tzatom, PL_ATOM, dstatom); } /* time_stamp */ return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_float, A1); } static PRED_IMPL("date_time_stamp", 2, date_time_stamp, 0) { ftm ftm; if ( !get_ftm(A1, &ftm) ) fail; cal_ftm(&ftm, HAS_STAMP); return PL_unify_float(A2, ftm.stamp); } /******************************* * GLIBC FUNCTIONS * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - These functions support strftime() %g, %G and %V. Code is copied from glibc 2.3.5. As Glibc is LGPL, there are no license issues. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifndef __isleap /* Nonzero if YEAR is a leap year (every 4 years, except every 100th isn't, and every 400th is). */ # define __isleap(year) \ ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) #endif /* The number of days from the first day of the first ISO week of this year to the year day YDAY with week day WDAY. ISO weeks start on Monday; the first ISO week has the year's first Thursday. YDAY may be as small as YDAY_MINIMUM. */ #define ISO_WEEK_START_WDAY 1 /* Monday */ #define ISO_WEEK1_WDAY 4 /* Thursday */ #define YDAY_MINIMUM (-366) #ifdef __GNUC__ __inline__ #endif static int iso_week_days(int yday, int wday) { /* Add enough to the first operand of % to make it nonnegative. */ int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; return (yday - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); } /******************************* * ERRORS * *******************************/ static int fmt_domain_error(const char *key, int value) { GET_LD term_t t = PL_new_term_ref(); PL_put_integer(t, value); return PL_error(NULL, 0, NULL, ERR_DOMAIN, PL_new_atom(key), t); } static int fmt_not_implemented(const char *key) { GET_LD term_t t = PL_new_term_ref(); PL_put_atom_chars(t, key); return PL_error(NULL, 0, NULL, ERR_EXISTENCE, PL_new_atom("format"), t); } /******************************* * FORMATTING * *******************************/ #define OUT1DIGIT(fd, val) \ { Sputcode('0'+(val)%10, fd); \ } #define OUT2DIGITS(fd, val) \ { Sputcode('0'+((val)/10)%10, fd); \ Sputcode('0'+(val)%10, fd); \ } #define OUT3DIGITS(fd, val) \ { Sputcode('0'+((val)/100)%10, fd); \ Sputcode('0'+((val)/10)%10, fd); \ Sputcode('0'+(val)%10, fd); \ } #define OUT2DIGITS_SPC(fd, val) \ { Sputcode(((val)/10 == 0 ? ' ' : '0'+((val)/10)%10), fd); \ Sputcode('0'+(val)%10, fd); \ } #define OUTNUMBER(fd, fmt, val) \ { Sfprintf(fd, fmt, val); \ } #define SUBFORMAT(f) \ { format_time(fd, f, ftm, posix); \ } #define OUTCHR(fd, c) \ { Sputcode(c, fd); \ } #define OUTSTR(str) \ { Sfputs(str, fd); \ } #define OUTSTRA(str) \ { foutstra(str, fd); \ } #define OUTATOM(a) \ { writeAtomToStream(fd, a); \ } static void foutstra(const char *str, IOSTREAM *fd) { wchar_t wbuf[256]; size_t n; if ( (n = mbstowcs(wbuf, str, sizeof(wbuf)/sizeof(wbuf[0])-1)) != (size_t)-1 ) { wchar_t *p; for(p=wbuf; n-- > 0; p++) Sputcode(*p, fd); } } static const char *abbred_weekday[] = { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; static const char *weekday[] = { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }; static const char *abbred_month[] = { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; static const char *month[] = { "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" }; #define NOARG (-1) static int format_time(IOSTREAM *fd, const wchar_t *format, ftm *ftm, int posix) { wint_t c; while((c = *format++)) { int arg = NOARG; switch(c) { case '%': arg = NOARG; fmt_next: switch((c = *format++)) { case 'a': /* %a: abbreviated weekday */ case 'A': /* %A: weekday */ case 'b': /* %b: abbreviated month */ case 'B': /* %B: month */ if ( posix ) { const char *s; cal_ftm(ftm, HAS_STAMP|HAS_WYDAY); switch( c ) { case 'a': s = abbred_weekday[ftm->tm.tm_wday]; break; case 'A': s = weekday[ftm->tm.tm_wday]; break; case 'b': s = abbred_month[ftm->tm.tm_mon]; break; case 'B': s = month[ftm->tm.tm_mon]; break; default: s = NULL; assert(0); } OUTSTR(s); break; } /*FALLTHROUGH*/ case 'c': /* %c: default representation */ case 'p': /* %p: AM/PM (locale) */ case 'P': /* %P: am/pm (locale) */ case 'x': /* %x: date in locale */ case 'X': /* %X: time in locale */ case_b: { char fmt[3]; char buf[256]; size_t n; fmt[0] = '%'; fmt[1] = (char)c; fmt[2] = EOS; cal_ftm(ftm, HAS_STAMP|HAS_WYDAY); /* conversion is not thread-safe under locale switch */ n = strftime(buf, sizeof(buf), fmt, &ftm->tm); OUTSTRA(buf); break; } case 'C': /* (year/100) as a 2-digit int */ { int year = ftm->tm.tm_year+1900; if ( year >= 0 && year < 10000 ) { int century = year/100; OUT2DIGITS(fd, century); } else { return fmt_domain_error("%C", year); } break; } case 'd': /* day of the month */ OUT2DIGITS(fd, ftm->tm.tm_mday); break; case 'D': /* %m/%d/%y */ SUBFORMAT(L"%m/%d/%y"); break; case 'e': /* day of the month */ OUT2DIGITS_SPC(fd, ftm->tm.tm_mday); break; case 'E': /* alternative format */ return fmt_not_implemented("%E"); case 'F': /* ISO 8601 date format */ SUBFORMAT(L"%Y-%m-%d"); break; case 'G': case 'g': case 'V': { int year, days; cal_ftm(ftm, HAS_STAMP|HAS_WYDAY); year = ftm->tm.tm_year+1900; days = iso_week_days(ftm->tm.tm_yday, ftm->tm.tm_wday); if ( days < 0 ) { year--; days = iso_week_days(ftm->tm.tm_yday + (365 + __isleap (year)), ftm->tm.tm_wday); } else { int d = iso_week_days(ftm->tm.tm_yday - (365 + __isleap (year)), ftm->tm.tm_wday); if (0 <= d) { /* This ISO week belongs to the next year. */ year++; days = d; } } switch(c) { case 'g': OUT2DIGITS(fd, (year % 100 + 100) % 100); break; case 'G': OUTNUMBER(fd, "%d", year); break; case 'V': OUT2DIGITS(fd, days/7+1); break; } break; } case 'h': /* Equivalent to %b. (SU) */ c = 'b'; goto case_b; case 'H': /* 0..23 hours */ OUT2DIGITS(fd, ftm->tm.tm_hour); break; case 'I': /* 01..12 hours */ OUT2DIGITS(fd, (ftm->tm.tm_hour)%12); break; case 'j': /* yday (001..366) */ cal_ftm(ftm, HAS_WYDAY); OUT3DIGITS(fd, ftm->tm.tm_yday+1); break; case 'k': /* 0..23 hours (leading space) */ OUT2DIGITS_SPC(fd, ftm->tm.tm_hour); break; case 'l': /* 1..12 hours (leading space) */ OUT2DIGITS_SPC(fd, (ftm->tm.tm_hour)%12); break; case 'm': /* 01..12 month */ OUT2DIGITS(fd, ftm->tm.tm_mon+1); break; case 'M': /* 00..59 minute */ OUT2DIGITS(fd, ftm->tm.tm_min); break; case 'n': /* newline */ OUTCHR(fd, '\n'); break; case 'O': return fmt_not_implemented("%O"); case 'r': /* The time in a.m./p.m. notation */ SUBFORMAT(L"%I:%M:%S %p"); /* TBD: :-separator locale handling */ break; case 'R': SUBFORMAT(L"%H:%M"); break; case 'f': /* Microseconds */ { int digits = (arg == NOARG ? 6 : arg); if ( digits > 0 ) { double ip; char fmt[64]; cal_ftm(ftm, HAS_STAMP); Ssprintf(fmt, "%%0%dlld", digits); OUTNUMBER(fd, fmt, (long)(modf(ftm->stamp, &ip) * pow(10, digits))); } break; } case 's': /* Seconds since 1970 */ cal_ftm(ftm, HAS_STAMP); OUTNUMBER(fd, "%.0f", ftm->stamp); break; case 'S': /* Seconds */ OUT2DIGITS(fd, ftm->tm.tm_sec); break; case 't': /* tab */ OUTCHR(fd, '\t'); break; case 'T': SUBFORMAT(L"%H:%M:%S"); break; case 'u': /* 1..7 weekday, mon=1 */ { int wday; cal_ftm(ftm, HAS_WYDAY); wday = (ftm->tm.tm_wday - 1 + 7) % 7 + 1; OUT1DIGIT(fd, wday); break; } case 'U': /* 00..53 weeknumber */ { int wk; cal_ftm(ftm, HAS_WYDAY); wk = (ftm->tm.tm_yday - (ftm->tm.tm_yday - ftm->tm.tm_wday + 7) % 7 + 7) / 7; OUT2DIGITS(fd, wk); break; } case 'w': /* 0..6 weekday */ cal_ftm(ftm, HAS_WYDAY); OUT1DIGIT(fd, ftm->tm.tm_wday); break; case 'W': /* 00..53 monday-based week number */ { int wk; cal_ftm(ftm, HAS_WYDAY); wk = (ftm->tm.tm_yday - (ftm->tm.tm_yday - ftm->tm.tm_wday + 8) % 7 + 7) / 7; OUT2DIGITS(fd, wk); break; } case 'y': /* 00..99 (year) */ OUT2DIGITS(fd, (ftm->tm.tm_year+1900) % 100); break; case 'Y': /* Year (decimal) */ OUTNUMBER(fd, "%d", ftm->tm.tm_year+1900); break; case 'z': /* Time-zone as offset */ { int min = -ftm->utcoff/60; if ( min >= 0 ) { OUTCHR(fd, '+'); } else { min = -min; OUTCHR(fd, '-'); } OUT2DIGITS(fd, min/60); OUT2DIGITS(fd, min%60); break; } case 'Z': /* Time-zone as name */ if ( ftm->tzname ) { OUTATOM(ftm->tzname); } else { OUTSTRA(tz_name(ftm->tm.tm_isdst)); } break; case '+': { char buf[26]; cal_ftm(ftm, HAS_WYDAY); asctime_r(&ftm->tm, buf); buf[24] = EOS; OUTSTRA(buf); } break; case '%': OUTCHR(fd, '%'); break; default: if ( isdigit(c) ) { if ( arg == NOARG ) arg = c - '0'; else arg = arg*10+(c-'0'); goto fmt_next; } } break; default: OUTCHR(fd, c); } } return TRUE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - format_time(+Spec, +Format, +Stamp) Issues: * Localtime/DST * Year is an int (not so bad) * Portability * Sub-second times - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static foreign_t pl_format_time(term_t out, term_t format, term_t time, int posix) { struct taia taia; struct caltime ct; struct ftm tb; int weekday, yearday; wchar_t *fmt; time_t unixt; int64_t ut64; size_t fmtlen; redir_context ctx; if ( !PL_get_wchars(format, &fmtlen, &fmt, CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) ) fail; memset(&tb, 0, sizeof(tb)); if ( get_taia(time, &taia, &tb.stamp) ) { double ip; ut64 = taia.sec.x - TAI_UTC_OFFSET; unixt = (time_t) ut64; if ( (int64_t)unixt == ut64 ) { tb.utcoff = tz_offset(); localtime_r(&unixt, &tb.tm); tb.sec = (double)tb.tm.tm_sec + modf(tb.stamp, &ip); if ( tb.tm.tm_isdst > 0 ) { tb.utcoff -= 3600; tb.isdst = TRUE; } tb.tzname = tz_name_as_atom(tb.tm.tm_isdst); tb.flags = HAS_STAMP|HAS_WYDAY; } else { caltime_utc(&ct, &taia.sec, &weekday, &yearday); tb.tm.tm_sec = ct.second; tb.tm.tm_min = ct.minute; tb.tm.tm_hour = ct.hour; tb.tm.tm_mday = ct.date.day; tb.tm.tm_mon = ct.date.month - 1; tb.tm.tm_year = ct.date.year - 1900; tb.tm.tm_wday = weekday; tb.tm.tm_yday = yearday; tb.tzname = ATOM_utc; tb.utcoff = 0; } } else if ( !get_ftm(time, &tb) ) { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, time); } if ( !setupOutputRedirect(out, &ctx, FALSE) ) fail; if ( format_time(ctx.stream, fmt, &tb, posix) ) return closeOutputRedirect(&ctx); /* takes care of I/O errors */ discardOutputRedirect(&ctx); fail; } static PRED_IMPL("format_time", 3, format_time3, 0) { return pl_format_time(A1, A2, A3, FALSE); } static PRED_IMPL("format_time", 4, format_time4, 0) { PRED_LD int posix = FALSE; atom_t locale; if ( !PL_get_atom_ex(A4, &locale) ) return FALSE; if ( locale == ATOM_posix ) posix = TRUE; else return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_locale, A4); return pl_format_time(A1, A2, A3, posix); } /******************************* * PUBLISH PREDICATES * *******************************/ BeginPredDefs(tai) PRED_DEF("stamp_date_time", 3, stamp_date_time, 0) PRED_DEF("date_time_stamp", 2, date_time_stamp, 0) PRED_DEF("format_time", 3, format_time3, 0) PRED_DEF("format_time", 4, format_time4, 0) PRED_DEF("swi_stamp_date_time", 3, stamp_date_time, 0) PRED_DEF("swi_date_time_stamp", 2, date_time_stamp, 0) PRED_DEF("swi_format_time", 3, format_time3, 0) PRED_DEF("swi_format_time", 4, format_time4, 0) EndPredDefs #if _YAP_NOT_INSTALLED_ install_t install(void) { PL_register_extensions(PL_predicates_from_tai); } #endif