#ifdef __cplusplus
extern
"C"
{
#endif
#include "ulib/util.h"
#ifdef __cplusplus
}
#endif
static
NV uu_time_v1(
const
struct_uu_t *in) {
U64 sum;
NV rv;
sum = ((U64)in->v1.time_high_and_version & 0x0fff) << 48
| ((U64)in->v1.time_mid) << 32
| (U64)in->v1.time_low;
sum -= 122192928000000000ULL;
rv = (NV)sum / 10000000.0;
return
rv;
}
static
NV uu_time_v4(
const
struct_uu_t *in) {
return
0.0;
}
static
NV uu_time_v6(
const
struct_uu_t *in) {
U64 sum;
NV rv;
sum = ((U64)in->v6.time_high) << 28
| ((U64)in->v6.time_mid) << 12
| ((U64)in->v6.time_low_and_version & 0x0fff);
sum -= 122192928000000000ULL;
rv = (NV)sum / 10000000.0;
return
rv;
}
static
NV uu_time_v7(
const
struct_uu_t *in) {
U64 sum;
NV rv;
sum = ((U64)in->v7.time_high) << 16
| (U64)in->v7.time_low;
rv = (NV)sum / 1000.0;
return
rv;
}
NV uu_time(
const
struct_uu_t *in) {
int
version;
version = in->v1.time_high_and_version >> 12;
switch
(version) {
case
1:
return
uu_time_v1(in);
case
4:
return
uu_time_v4(in);
case
6:
return
uu_time_v6(in);
case
7:
return
uu_time_v7(in);
}
return
0;
}
UV uu_type(
const
struct_uu_t *in) {
UV type;
type = in->v1.time_high_and_version >> 12;
if
(type <= 8)
return
type;
return
0;
}
UV uu_variant(
const
struct_uu_t *in) {
U16 variant;
variant = in->v1.clock_seq_and_variant;
if
((variant & 0x8000) == 0)
return
0;
if
((variant & 0x4000) == 0)
return
1;
if
((variant & 0x2000) == 0)
return
2;
return
3;
}
#define PERL_ARGS_ASSERT_DOPOPTOSUB_AT assert(cxstk)
#ifdef PERL_GLOBAL_STRUCT
# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS()
#else
# define dVAR dNOOP
#endif
#ifndef dopoptosub
#define dopoptosub(plop) dopoptosub_at(cxstack, (plop))
#endif
#ifndef dopoptosub_at
#if !defined(PERL_IMPLICIT_CONTEXT)
# define dopoptosub_at my_dopoptosub_at
#else
# define dopoptosub_at(a,b) my_dopoptosub_at(aTHX_ a,b)
#endif
#endif
STATIC I32
my_dopoptosub_at(pTHX_
const
PERL_CONTEXT *cxstk, I32 startingblock)
{
dVAR;
I32 i;
PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
for
(i = startingblock; i >= 0; i--) {
register
const
PERL_CONTEXT *
const
cx = &cxstk[i];
switch
(CxTYPE(cx)) {
default
:
continue
;
case
CXt_EVAL:
case
CXt_SUB:
case
CXt_FORMAT:
DEBUG_l( Perl_deb(aTHX_
"(dopoptosub_at(): found sub at cx=%ld)\n"
, (
long
)i));
return
i;
}
}
return
i;
}
const
PERL_CONTEXT *
my_caller_cx(pTHX_ I32 count,
const
PERL_CONTEXT **dbcxp)
{
register
I32 cxix = dopoptosub(cxstack_ix);
register
const
PERL_CONTEXT *cx;
register
const
PERL_CONTEXT *ccstack = cxstack;
const
PERL_SI *top_si = PL_curstackinfo;
for
(;;) {
while
(cxix < 0 && top_si->si_type != PERLSI_MAIN) {
top_si = top_si->si_prev;
ccstack = top_si->si_cxstack;
cxix = dopoptosub_at(ccstack, top_si->si_cxix);
}
if
(cxix < 0)
return
NULL;
if
(PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
count++;
if
(!count--)
break
;
cxix = dopoptosub_at(ccstack, cxix - 1);
}
cx = &ccstack[cxix];
if
(dbcxp) *dbcxp = cx;
if
(CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
const
I32 dbcxix = dopoptosub_at(ccstack, cxix - 1);
if
(PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
cx = &ccstack[dbcxix];
}
return
cx;
}
void
my_croak_caller(
const
char
*pat, ...) {
dTHX;
va_list
args;
const
PERL_CONTEXT *cx = my_caller_cx(aTHX_ 0, NULL);
assert
(cx);
PL_curcop = cx->blk_oldcop;
va_start
(args, pat);
vcroak(pat, &args);
NOT_REACHED;
va_end
(args);
}