Compress-LZF/LZF.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* try to be compatible with older perls */
/* SvPV_nolen() macro first defined in 5.005_55 */
/* this is slow, not threadsafe, but works */
#include "patchlevel.h"
#if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55))
static STRLEN nolen_na;
# define SvPV_nolen(sv) SvPV ((sv), nolen_na)
#endif
#if PATCHLEVEL < 6
# define call_sv perl_call_sv
#endif

#include "lzf_c.c"
#include "lzf_d.c"

/* we re-use the storable header for our purposes */
#define MAGIC_LO        0
#define MAGIC_U         0 /* uncompressed data follows */
#define MAGIC_C         1 /* compressed data follows */
#define MAGIC_R         4 /* storable (reference, freeze) */
#define MAGIC_CR        3 /* storable (reference, freeze), compressed */
#define MAGIC_HI        7 /* room for one higher storable major */

#define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l))

static CV *storable_mstore, *storable_mretrieve;

static SV *
compress_sv (SV *data, char cprepend, char uprepend)
{
  STRLEN usize, csize;
  char *src = (char *)SvPV (data, usize);

  if (usize)
    {
      SV *ret = NEWSV (0, usize + 1);
      unsigned char *dst;
      int skip = 0;

      SvPOK_only (ret);
      dst = (unsigned char *)SvPVX (ret);

      if (cprepend)
        dst[skip++] = cprepend;

      if (usize < 0x80)
        {
          dst[skip++] = usize;
        }
      else if (usize < 0x800) 
        {
          dst[skip++] = (( usize >>  6)         | 0xc0);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize < 0x10000) 
        {
          dst[skip++] = (( usize >> 12)         | 0xe0);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize < 0x200000) 
        {
          dst[skip++] = (( usize >> 18)         | 0xf0);
          dst[skip++] = (((usize >> 12) & 0x3f) | 0x80);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize < 0x4000000) 
        {
          dst[skip++] = (( usize >> 24)         | 0xf8);
          dst[skip++] = (((usize >> 18) & 0x3f) | 0x80);
          dst[skip++] = (((usize >> 12) & 0x3f) | 0x80);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else
        croak ("compress can only compress up to %ld bytes", 0x4000000-1);

      /* 11 bytes is the smallest compressible string */
      csize = usize < 11 ? 0 :
              lzf_compress (src, usize,
                                  dst + skip,
                                  usize - skip);

      if (csize)
        {
          SvCUR_set (ret, csize + skip);
        }
      else if (!uprepend)
        {
          SvREFCNT_dec (ret);
          ret = SvREFCNT_inc (data);
        }
      else
        {
          *dst++ = 0;

          Move ((void *)src, (void *)dst, usize, unsigned char);

          SvCUR_set (ret, usize + 1);
        }

      return ret;
    }
  else
    return newSVpv ("", 0);
}

static SV *
decompress_sv (SV *data, int skip)
{
  STRLEN usize, csize;
  unsigned char *src = (unsigned char *)SvPV (data, csize) + skip;

  if (csize)
    {
      void *dst;
      SV *ret;

      csize -= skip;

      if (src[0])
        {
          if (!(src[0] & 0x80))
            {
              csize -= 1;
              usize =                 *src++ & 0xff;
            }
          else if (!(src[0] & 0x20))
            {
              csize -= 2;
              usize =                 *src++ & 0x1f;
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x10))
            {
              csize -= 3;
              usize =                 *src++ & 0x0f;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x08))
            {
              csize -= 4;
              usize =                 *src++ & 0x07;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x04))
            {
              csize -= 5;
              usize =                 *src++ & 0x03;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else
            croak ("compressed data corrupted");
                    
          ret = NEWSV (0, usize);
          SvPOK_only (ret);
          dst = SvPVX (ret);

          if (lzf_decompress (src, csize, dst, usize) != usize)
            croak ("compressed data corrupted", csize, skip, usize);
        }
      else
        {
          usize = csize - 1;
          ret = NEWSV (0, usize);
          SvPOK_only (ret);

          Move ((void *)(src + 1), (void *)SvPVX (ret), usize, unsigned char);
      }

      SvCUR_set (ret, usize);

      return ret;
    }
  else
    return newSVpvn ("", 0);
}

static void
need_storable(void)
{
#if PATCHLEVEL < 6
  perl_eval_pv ("require Storable;", 1);
#else
  load_module (PERL_LOADMOD_NOIMPORT, newSVpv ("Storable", 0), Nullsv);
#endif

  storable_mstore    = GvCV (gv_fetchpv ("Storable::mstore"   , TRUE, SVt_PVCV));
  storable_mretrieve = GvCV (gv_fetchpv ("Storable::mretrieve", TRUE, SVt_PVCV));
}

MODULE = Compress::LZF   PACKAGE = Compress::LZF

void
compress(data)
        SV *    data
        PROTOTYPE: $
        PPCODE:
        XPUSHs (sv_2mortal (compress_sv (data, 0, 1)));

void
decompress(data)
        SV *    data
        PROTOTYPE: $
        PPCODE:
        XPUSHs (sv_2mortal (decompress_sv (data, 0)));

void
sfreeze(sv)
        SV *    sv
        ALIAS:
        sfreeze_cr = 1
        sfreeze_c  = 2
        PROTOTYPE: $
        PPCODE:

        if (SvTYPE(sv) != SVt_IV
            && SvTYPE(sv) != SVt_NV
            && SvTYPE(sv) != SVt_PV) /* mstore */
          {
            if (!storable_mstore)
              need_storable ();

            PUSHMARK (SP);
            XPUSHs (sv);
            PUTBACK;

            if (1 != call_sv ((SV *)storable_mstore, G_SCALAR))
              croak ("Storable::mstore didn't return a single scalar");

            SPAGAIN;

            sv = POPs;

            if (SvPVX (sv)[0] != MAGIC_R)
              croak ("Storable format changed, need newer version of Compress::LZF");

            if (ix) /* compress */
              XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_CR, 0)));
            else
              XPUSHs (sv);
          }
        else if (IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI))
          XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 1))); /* need to prefix only */
        else if (ix == 2) /* compress always */
          XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 0)));
        else /* don't compress */
          XPUSHs (sv_2mortal (SvREFCNT_inc (sv)));

void
sthaw(sv)
        SV *    sv
        PROTOTYPE: $
        PPCODE:
        char hdr = SvPVX (sv)[0];

        if (IN_RANGE (hdr, MAGIC_LO, MAGIC_HI))
          {
            switch (SvPVX (sv)[0])
              {
                case MAGIC_U:
                  XPUSHs (sv_2mortal (decompress_sv (sv, 0)));
                  break;

                case MAGIC_C:
                  XPUSHs (sv_2mortal (decompress_sv (sv, 1)));
                  break;

                case MAGIC_CR:
                  sv = sv_2mortal (decompress_sv (sv, 1)); /* mortal could be optimized */
                case MAGIC_R:
                  if (!storable_mstore)
                    need_storable ();

                  PUSHMARK (SP);
                  XPUSHs (sv);
                  PUTBACK;

                  if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
                    croak ("Storable::mstore didn't return a single scalar");

                  SPAGAIN;

                  /*XPUSHs (POPs);*/

                  break; 

                default:
                  croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
              }
          }
        else
          XPUSHs (sv_2mortal (SvREFCNT_inc (sv)));
Revision:	1.3
Committed:	Thu Sep 27 19:51:26 2001 UTC (22 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.2:	+3 -1 lines
Log Message:	* empty log message *
#	Content
1	#include "EXTERN.h"
2	#include "perl.h"
3	#include "XSUB.h"
4
5	/* try to be compatible with older perls */
6	/* SvPV_nolen() macro first defined in 5.005_55 */
7	/* this is slow, not threadsafe, but works */
8	#include "patchlevel.h"
9	#if (PATCHLEVEL == 4) \|\| ((PATCHLEVEL == 5) && (SUBVERSION < 55))
10	static STRLEN nolen_na;
11	# define SvPV_nolen(sv) SvPV ((sv), nolen_na)
12	#endif
13	#if PATCHLEVEL < 6
14	# define call_sv perl_call_sv
15	#endif
16
17	#include "lzf_c.c"
18	#include "lzf_d.c"
19
20	/* we re-use the storable header for our purposes */
21	#define MAGIC_LO 0
22	#define MAGIC_U 0 /* uncompressed data follows */
23	#define MAGIC_C 1 /* compressed data follows */
24	#define MAGIC_R 4 /* storable (reference, freeze) */
25	#define MAGIC_CR 3 /* storable (reference, freeze), compressed */
26	#define MAGIC_HI 7 /* room for one higher storable major */
27
28	#define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l))
29
30	static CV storable_mstore, storable_mretrieve;
31
32	static SV *
33	compress_sv (SV *data, char cprepend, char uprepend)
34	{
35	STRLEN usize, csize;
36	char src = (char )SvPV (data, usize);
37
38	if (usize)
39	{
40	SV *ret = NEWSV (0, usize + 1);
41	unsigned char *dst;
42	int skip = 0;
43
44	SvPOK_only (ret);
45	dst = (unsigned char *)SvPVX (ret);
46
47	if (cprepend)
48	dst[skip++] = cprepend;
49
50	if (usize < 0x80)
51	{
52	dst[skip++] = usize;
53	}
54	else if (usize < 0x800)
55	{
56	dst[skip++] = (( usize >> 6) \| 0xc0);
57	dst[skip++] = (( usize & 0x3f) \| 0x80);
58	}
59	else if (usize < 0x10000)
60	{
61	dst[skip++] = (( usize >> 12) \| 0xe0);
62	dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
63	dst[skip++] = (( usize & 0x3f) \| 0x80);
64	}
65	else if (usize < 0x200000)
66	{
67	dst[skip++] = (( usize >> 18) \| 0xf0);
68	dst[skip++] = (((usize >> 12) & 0x3f) \| 0x80);
69	dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
70	dst[skip++] = (( usize & 0x3f) \| 0x80);
71	}
72	else if (usize < 0x4000000)
73	{
74	dst[skip++] = (( usize >> 24) \| 0xf8);
75	dst[skip++] = (((usize >> 18) & 0x3f) \| 0x80);
76	dst[skip++] = (((usize >> 12) & 0x3f) \| 0x80);
77	dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
78	dst[skip++] = (( usize & 0x3f) \| 0x80);
79	}
80	else
81	croak ("compress can only compress up to %ld bytes", 0x4000000-1);
82
83	/* 11 bytes is the smallest compressible string */
84	csize = usize < 11 ? 0 :
85	lzf_compress (src, usize,
86	dst + skip,
87	usize - skip);
88
89	if (csize)
90	{
91	SvCUR_set (ret, csize + skip);
92	}
93	else if (!uprepend)
94	{
95	SvREFCNT_dec (ret);
96	ret = SvREFCNT_inc (data);
97	}
98	else
99	{
100	*dst++ = 0;
101
102	Move ((void )src, (void )dst, usize, unsigned char);
103
104	SvCUR_set (ret, usize + 1);
105	}
106
107	return ret;
108	}
109	else
110	return newSVpv ("", 0);
111	}
112
113	static SV *
114	decompress_sv (SV *data, int skip)
115	{
116	STRLEN usize, csize;
117	unsigned char src = (unsigned char )SvPV (data, csize) + skip;
118
119	if (csize)
120	{
121	void *dst;
122	SV *ret;
123
124	csize -= skip;
125
126	if (src[0])
127	{
128	if (!(src[0] & 0x80))
129	{
130	csize -= 1;
131	usize = *src++ & 0xff;
132	}
133	else if (!(src[0] & 0x20))
134	{
135	csize -= 2;
136	usize = *src++ & 0x1f;
137	usize = (usize << 6) \| (*src++ & 0x3f);
138	}
139	else if (!(src[0] & 0x10))
140	{
141	csize -= 3;
142	usize = *src++ & 0x0f;
143	usize = (usize << 6) \| (*src++ & 0x3f);
144	usize = (usize << 6) \| (*src++ & 0x3f);
145	}
146	else if (!(src[0] & 0x08))
147	{
148	csize -= 4;
149	usize = *src++ & 0x07;
150	usize = (usize << 6) \| (*src++ & 0x3f);
151	usize = (usize << 6) \| (*src++ & 0x3f);
152	usize = (usize << 6) \| (*src++ & 0x3f);
153	}
154	else if (!(src[0] & 0x04))
155	{
156	csize -= 5;
157	usize = *src++ & 0x03;
158	usize = (usize << 6) \| (*src++ & 0x3f);
159	usize = (usize << 6) \| (*src++ & 0x3f);
160	usize = (usize << 6) \| (*src++ & 0x3f);
161	usize = (usize << 6) \| (*src++ & 0x3f);
162	}
163	else
164	croak ("compressed data corrupted");
165
166	ret = NEWSV (0, usize);
167	SvPOK_only (ret);
168	dst = SvPVX (ret);
169
170	if (lzf_decompress (src, csize, dst, usize) != usize)
171	croak ("compressed data corrupted", csize, skip, usize);
172	}
173	else
174	{
175	usize = csize - 1;
176	ret = NEWSV (0, usize);
177	SvPOK_only (ret);
178
179	Move ((void )(src + 1), (void )SvPVX (ret), usize, unsigned char);
180	}
181
182	SvCUR_set (ret, usize);
183
184	return ret;
185	}
186	else
187	return newSVpvn ("", 0);
188	}
189
190	static void
191	need_storable(void)
192	{
193	#if PATCHLEVEL < 6
194	perl_eval_pv ("require Storable;", 1);
195	#else
196	load_module (PERL_LOADMOD_NOIMPORT, newSVpv ("Storable", 0), Nullsv);
197	#endif
198
199	storable_mstore = GvCV (gv_fetchpv ("Storable::mstore" , TRUE, SVt_PVCV));
200	storable_mretrieve = GvCV (gv_fetchpv ("Storable::mretrieve", TRUE, SVt_PVCV));
201	}
202
203	MODULE = Compress::LZF PACKAGE = Compress::LZF
204
205	void
206	compress(data)
207	SV * data
208	PROTOTYPE: $
209	PPCODE:
210	XPUSHs (sv_2mortal (compress_sv (data, 0, 1)));
211
212	void
213	decompress(data)
214	SV * data
215	PROTOTYPE: $
216	PPCODE:
217	XPUSHs (sv_2mortal (decompress_sv (data, 0)));
218
219	void
220	sfreeze(sv)
221	SV * sv
222	ALIAS:
223	sfreeze_cr = 1
224	sfreeze_c = 2
225	PROTOTYPE: $
226	PPCODE:
227
228	if (SvTYPE(sv) != SVt_IV
229	&& SvTYPE(sv) != SVt_NV
230	&& SvTYPE(sv) != SVt_PV) /* mstore */
231	{
232	if (!storable_mstore)
233	need_storable ();
234
235	PUSHMARK (SP);
236	XPUSHs (sv);
237	PUTBACK;
238
239	if (1 != call_sv ((SV *)storable_mstore, G_SCALAR))
240	croak ("Storable::mstore didn't return a single scalar");
241
242	SPAGAIN;
243
244	sv = POPs;
245
246	if (SvPVX (sv)[0] != MAGIC_R)
247	croak ("Storable format changed, need newer version of Compress::LZF");
248
249	if (ix) /* compress */
250	XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_CR, 0)));
251	else
252	XPUSHs (sv);
253	}
254	else if (IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI))
255	XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 1))); /* need to prefix only */
256	else if (ix == 2) /* compress always */
257	XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 0)));
258	else /* don't compress */
259	XPUSHs (sv_2mortal (SvREFCNT_inc (sv)));
260
261	void
262	sthaw(sv)
263	SV * sv
264	PROTOTYPE: $
265	PPCODE:
266	char hdr = SvPVX (sv)[0];
267
268	if (IN_RANGE (hdr, MAGIC_LO, MAGIC_HI))
269	{
270	switch (SvPVX (sv)[0])
271	{
272	case MAGIC_U:
273	XPUSHs (sv_2mortal (decompress_sv (sv, 0)));
274	break;
275
276	case MAGIC_C:
277	XPUSHs (sv_2mortal (decompress_sv (sv, 1)));
278	break;
279
280	case MAGIC_CR:
281	sv = sv_2mortal (decompress_sv (sv, 1)); /* mortal could be optimized */
282	case MAGIC_R:
283	if (!storable_mstore)
284	need_storable ();
285
286	PUSHMARK (SP);
287	XPUSHs (sv);
288	PUTBACK;
289
290	if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
291	croak ("Storable::mstore didn't return a single scalar");
292
293	SPAGAIN;
294
295	/XPUSHs (POPs);/
296
297	break;
298
299	default:
300	croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
301	}
302	}
303	else
304	XPUSHs (sv_2mortal (SvREFCNT_inc (sv)));