/* -*- Mode: C -*- */
#define PERL_NO_GET_CONTEXT 1
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
MODULE = Sort::Key::LargeInt            PACKAGE = Sort::Key::LargeInt           
void
encode_largeint(li=NULL)
    SV *li
PPCODE:
    if (!li) 
        li = DEFSV;
    {
        STRLEN len;
        const char *li_pv = SvPV(li, len);
        STRLEN i;
        int neg = 0;
        const char *from;
        const char *start;
        const char *top = li_pv + len;
        STRLEN digits;
        STRLEN chunks;
        STRLEN retlen;
        SV *ret;
        char *ret_pv;
        char *to;
        start = li_pv;
        /* look for sign */
        if (len) {
            if (*start == '-') {
                start++;
                neg = 1;
            }
            else if (*start == '+') {
                start++;
            }
        }
        /* discard zeros at the left */
        for (; start < top && (*start == '0' || *start == '_'); start++);
        /* count the number of digits in order to preallocate the returned SV buffer */
        for (digits = 0, from = start; from < top; from++) {
            if (*from >= '0' && *from <= '9')
                digits++;
            else if (*from != '_')
                break;
        }
        /* calculate target length */
        chunks = (digits + 8 ) / 9;
        retlen = chunks / 127 + 1 + chunks * 4 + 1;
        ret = sv_2mortal(newSV(retlen));
        SvPOK_on(ret);
        to = ret_pv = SvPV_nolen(ret);
         
        /* store number length prefix with sign */
        for (i = chunks; i >= 127; i -= 127)
            *(to++) = (neg ? 1 : 255);
        *(to++) = (neg ? 128 - i : 128 + i);
        /* compress number */
        from = start;
        while (digits) {
            int digits_in_chunk = (digits - 1) % 9 + 1;
            U32 acu = 0;
            for (i = 0; i < digits_in_chunk; i++, from++) {
                while (*from == '_') from++;
                acu *= 10;
                acu += (*from - '0');
                /* fprintf(stderr, "acu: %d\n", acu); */
            }
            if (neg)
                acu = 1000000000 - acu;
            else
                acu += 1000000000;
            *(to++) = (acu >> 24) & 255;
            *(to++) = (acu >> 16) & 255;
            *(to++) = (acu >> 8) & 255;
            *(to++) = acu & 255;
            digits -= digits_in_chunk;      
        }
        /* adjust return SV */
        *to = '\0';
        SvCUR_set(ret, to - ret_pv);
        if (SvCUR(ret) != retlen - 1) 
            Perl_croak(aTHX_ "internal error, possible memory corruption (num: %s, cur: %d, exp: %d)",
                       li_pv, SvCUR(ret), retlen - 1);
        EXTEND(SP, 1);
        ST(0) = ret;
        XSRETURN(1);
    }