File Coverage

ulib/util.c

Criterion	Covered	Total	%
statement	67	77	87.0
branch	19	42	45.2
condition			n/a
subroutine			n/a
pod			n/a
total	86	119	72.2

#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;
}

/* a.k.a. version */
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;
}

/******************************************************************************
  * all for croak_caller before 5.13.4.
*/
#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 (;;) {
        /* we may be in a higher stacklevel, so dig down deeper */
        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;
        /* caller() should not report the automatic calls to &DB::sub */
        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);
        /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
                      field below is defined for any cx. */
        /* caller() should not report the automatic calls to &DB::sub */
                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);

    /* make error appear at call site */
    assert(cx);
    PL_curcop = cx->blk_oldcop;

    va_start(args, pat);
    vcroak(pat, &args);
    NOT_REACHED; /* NOTREACHED */
    va_end(args);
}
/******************************************************************************/

/* ex:set ts=2 sw=2 itab=spaces: */