Reduce memory footprint of literal strings
Ilya Zakharevich [Tue, 1 Apr 1997 16:34:37 +0000 (11:34 -0500)]
Subject: Fix for memory allocation on 'string'

Currently qq/a/ takes 2/3 of memory of "a" or 'a'. Test with

> env PERL_DEBUG_MSTATS=2 perl -e '$#a=10000; $a[$i] = qq// while $i++ <10000'

Memory allocation statistics after compilation: (buckets 8..8192)
   17552 free:     0     9    24    16    16   3   1     2   1 0 1
   43888 used:     0   119   232   176    16   5   3    10   0 0 1
Total sbrk():    61800. Odd ends: sbrk():     360, malloc():       0 bytes.
Memory allocation statistics after execution:   (buckets 8..65536)
   17136 free:     0   121    21    15    16   3   1     0   1 0 1 0 0 0
  515344 used:     0 10119   235   177    16   5   3   250   0 0 1 0 0 1
Total sbrk():   532840. Odd ends: sbrk():     360, malloc():       0 bytes.

> env PERL_DEBUG_MSTATS=2 perl -e '$#a=10000; $a[$i] = "a" while $i++ <10000'

Memory allocation statistics after compilation: (buckets 8..8192)
   17520 free:     0     9    23    16    16   3   1     2   1 0 1
   43920 used:     0   119   233   176    16   5   3    10   0 0 1
Total sbrk():    61800. Odd ends: sbrk():     360, malloc():       0 bytes.
Memory allocation statistics after execution:   (buckets 8..65536)
   17616 free:     0   121     4    15    16   3   1     1   1 0 1 0 0 0
  713520 used:     0 10119 10236   177    16   5   3   131   0 0 1 0 0 1
Total sbrk():   731496. Odd ends: sbrk():     360, malloc():       0 bytes.

The following patch fixes it:

p5p-msgid: 1997Apr1.113438.1913905@hmivax.humgen.upenn.edu

toke.c

diff --git a/toke.c b/toke.c
index b96e23e..ff9049d 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -622,7 +622,11 @@ sublex_start()
        return THING;
     }
     if (op_type == OP_CONST || op_type == OP_READLINE) {
-       yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
+       SV *sv = q(lex_stuff);
+       SV *sv1 = newSVpv(SvPV(sv, na), SvCUR(sv));     /* Make PV of PVIV. */
+
+       SvREFCNT_dec(sv);
+       yylval.opval = (OP*)newSVOP(op_type, 0, sv1);
        lex_stuff = Nullsv;
        return THING;
     }