From d93e3b8ce477b5ca3fdd199244bc7d258ae60fdd Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Wed, 1 Jan 2014 09:03:39 +0000 Subject: [PATCH] Update Time-Piece to CPAN version 1.26 [DELTA] 1.26 2013-12-29 - no changes since previous (trial) release 1.25_01 2013-12-16 - fix compiling for WinCE, execution is untested - add a .gitignore (from Win32::API) - fix a compiler warning about unused var, and add inlining - add PERL_NO_GET_CONTEXT to XS to bring the binary into 21st century - refactor XS code to remove large sections of duplicate machine code - fix _crt_localtime to return year only once, previously _crt_localtime returned year (item #6) twice in the list --- Porting/Maintainers.pl | 2 +- cpan/Time-Piece/Piece.pm | 2 +- cpan/Time-Piece/Piece.xs | 166 ++++++++++++++++++++++++++------------------- cpan/Time-Piece/Seconds.pm | 2 +- 4 files changed, 99 insertions(+), 73 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 8e21940..9cb75c5 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1228,7 +1228,7 @@ use File::Glob qw(:case); }, 'Time::Piece' => { - 'DISTRIBUTION' => 'RJBS/Time-Piece-1.24.tar.gz', + 'DISTRIBUTION' => 'RJBS/Time-Piece-1.26.tar.gz', 'FILES' => q[cpan/Time-Piece], }, diff --git a/cpan/Time-Piece/Piece.pm b/cpan/Time-Piece/Piece.pm index 3577718..895480c 100644 --- a/cpan/Time-Piece/Piece.pm +++ b/cpan/Time-Piece/Piece.pm @@ -19,7 +19,7 @@ our %EXPORT_TAGS = ( ':override' => 'internal', ); -our $VERSION = '1.24'; +our $VERSION = '1.26'; bootstrap Time::Piece $VERSION; diff --git a/cpan/Time-Piece/Piece.xs b/cpan/Time-Piece/Piece.xs index e5a77c7..bdf4860 100644 --- a/cpan/Time-Piece/Piece.xs +++ b/cpan/Time-Piece/Piece.xs @@ -1,6 +1,7 @@ #ifdef __cplusplus extern "C" { #endif +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -9,6 +10,14 @@ extern "C" { } #endif +#ifdef INLINE +# define TP_INLINE INLINE /* TP = Time::Piece */ +#elif defined(_MSC_VER) +# define TP_INLINE __forceinline /* __inline often doesn't work in O1 */ +#else +# define TP_INLINE inline +#endif + /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) * fields for which we don't have Configure support prior to Perl 5.8.0: * char *tm_zone; -- abbreviation of timezone name @@ -133,6 +142,10 @@ my_init_tm(struct tm *ptm) /* see mktime, strftime and asctime */ #undef getenv #undef putenv +# ifdef UNDER_CE +# define getenv xcegetenv +# define putenv xceputenv +# endif #undef malloc #undef free @@ -945,15 +958,73 @@ label: } -char * +TP_INLINE char * our_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm) { - char *ret; int got_GMT = 0; return _strptime(aTHX_ buf, fmt, tm, &got_GMT); } +/* Saves alot of machine code. + Takes a (auto) SP, which may or may not have been PUSHed before, puts + tm struct members on Perl stack, then returns new, advanced, SP to caller. + Assign the return of push_common_tm to your SP, so you can continue to PUSH + or do a PUTBACK and return eventually. + !!!! push_common_tm does not touch PL_stack_sp !!!! + !!!! do not use PUTBACK then SPAGAIN semantics around push_common_tm !!!! + !!!! You must mortalize whatever push_common_tm put on stack yourself to + avoid leaking !!!! +*/ +SV ** +push_common_tm(pTHX_ SV ** SP, struct tm *mytm) +{ + PUSHs(newSViv(mytm->tm_sec)); + PUSHs(newSViv(mytm->tm_min)); + PUSHs(newSViv(mytm->tm_hour)); + PUSHs(newSViv(mytm->tm_mday)); + PUSHs(newSViv(mytm->tm_mon)); + PUSHs(newSViv(mytm->tm_year)); + PUSHs(newSViv(mytm->tm_wday)); + PUSHs(newSViv(mytm->tm_yday)); + return SP; +} + +/* specialized common end of 2 XSUBs + SV ** SP -- pass your (auto) SP, which has not been PUSHed before, but was + reset to 0 (PPCODE only or SP -= items or XSprePUSH) + tm *mytm -- a tm *, will be proprocessed with my_mini_mktime + return -- none, after calling return_11part_tm, you must call "return;" + no exceptions +*/ +void +return_11part_tm(pTHX_ SV ** SP, struct tm *mytm) +{ + my_mini_mktime(mytm); + + /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */ + + EXTEND(SP, 11); + SP = push_common_tm(aTHX_ SP, mytm); + /* isdst */ + PUSHs(newSViv(0)); + /* epoch */ + PUSHs(newSViv(0)); + /* islocal */ + PUSHs(newSViv(0)); + PUTBACK; + { + SV ** endsp = SP; /* the SV * under SP needs to be mortaled */ + SP -= (11 - 1); /* subtract 0 based count of SVs to mortal */ +/* mortal target of SP, then increment before function call + so SP is already calculated before next comparison to not stall CPU */ + do { + sv_2mortal(*SP++); + } while(SP <= endsp); + } + return; +} + MODULE = Time::Piece PACKAGE = Time::Piece PROTOTYPES: ENABLE @@ -1037,8 +1108,9 @@ _strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1 void _tzset() PPCODE: + PUTBACK; /* makes rest of this function tailcall friendly */ my_tzset(aTHX); - + return; /* skip XSUBPP's PUTBACK */ void _strptime ( string, format ) @@ -1058,26 +1130,9 @@ _strptime ( string, format ) if (*remainder != '\0') { warn("garbage at end of string in strptime: %s", remainder); } - - my_mini_mktime(&mytm); - /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */ - - EXTEND(SP, 11); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - /* isdst */ - PUSHs(sv_2mortal(newSViv(0))); - /* epoch */ - PUSHs(sv_2mortal(newSViv(0))); - /* islocal */ - PUSHs(sv_2mortal(newSViv(0))); + return_11part_tm(aTHX_ SP, &mytm); + return; void _mini_mktime(int sec, int min, int hour, int mday, int mon, int year) @@ -1094,61 +1149,32 @@ _mini_mktime(int sec, int min, int hour, int mday, int mon, int year) mytm.tm_mday = mday; mytm.tm_mon = mon; mytm.tm_year = year; - - my_mini_mktime(&mytm); - EXTEND(SP, 11); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - /* isdst */ - PUSHs(sv_2mortal(newSViv(0))); - /* epoch */ - PUSHs(sv_2mortal(newSViv(0))); - /* islocal */ - PUSHs(sv_2mortal(newSViv(0))); + return_11part_tm(aTHX_ SP, &mytm); + return; void _crt_localtime(time_t sec) + ALIAS: + _crt_gmtime = 1 PREINIT: struct tm mytm; PPCODE: - mytm = *localtime(&sec); + if(ix) mytm = *gmtime(&sec); + else mytm = *localtime(&sec); /* Need to get: $s,$n,$h,$d,$m,$y */ EXTEND(SP, 9); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_isdst))); - -void -_crt_gmtime(time_t sec) - PREINIT: - struct tm mytm; - PPCODE: - mytm = *gmtime(&sec); - /* Need to get: $s,$n,$h,$d,$m,$y */ - - EXTEND(SP, 9); - PUSHs(sv_2mortal(newSViv(mytm.tm_sec))); - PUSHs(sv_2mortal(newSViv(mytm.tm_min))); - PUSHs(sv_2mortal(newSViv(mytm.tm_hour))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_mon))); - PUSHs(sv_2mortal(newSViv(mytm.tm_year))); - PUSHs(sv_2mortal(newSViv(mytm.tm_wday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_yday))); - PUSHs(sv_2mortal(newSViv(mytm.tm_isdst))); - + SP = push_common_tm(aTHX_ SP, &mytm); + PUSHs(newSViv(mytm.tm_isdst)); + PUTBACK; + { + SV ** endsp = SP; /* the SV * under SP needs to be mortaled */ + SP -= (9 - 1); /* subtract 0 based count of SVs to mortal */ +/* mortal target of SP, then increment before function call + so SP is already calculated before next comparison to not stall CPU */ + do { + sv_2mortal(*SP++); + } while(SP <= endsp); + } + return; diff --git a/cpan/Time-Piece/Seconds.pm b/cpan/Time-Piece/Seconds.pm index 0d67ce5..3e82ec5 100644 --- a/cpan/Time-Piece/Seconds.pm +++ b/cpan/Time-Piece/Seconds.pm @@ -2,7 +2,7 @@ package Time::Seconds; use strict; use vars qw/@EXPORT @EXPORT_OK/; -our $VERSION = '1.24'; +our $VERSION = '1.26'; use Exporter 5.57 'import'; -- 2.7.4