diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-11-26 20:48:00 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-11-26 20:48:00 +1200 |
commit | bbce6d69784bf43b0e69e8d312042d65f258af23 (patch) | |
tree | eb5810e67656c19b6fb34dd0160c9131f24f65d1 /hv.c | |
parent | 6d82b38436d2a39ffb7413e68ad91495cd645fff (diff) | |
download | perl-bbce6d69784bf43b0e69e8d312042d65f258af23.tar.gz |
[inseparable changes from patch from perl5.003_08 to perl5.003_09]
CORE LANGUAGE CHANGES
Subject: Lexical locales
From: Chip Salzenberg <chip@atlantic.net>
Files: too many to list
make effectiveness of locales depend on C<use locale>
Subject: Lexical scoping cleanup
From: Chip Salzenberg <chip@atlantic.net>
Files: many... but mostly perly.y and toke.c
tighten scoping of lexical variables, somewhat on the
new constructs and somewhat on the old
Subject: memory corruption / security bug in sysread,syswrite + patch
Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET)
From: Jarkko Hietaniemi <jhi@cc.hut.fi>
Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t
Msg-ID: <199611251946.VAA30459@alpha.hut.fi>
(applied based on p5p patch as commit d7090df90a9cb89c83787d916e40d92a616b146d)
DOCUMENTATION
Subject: perldiag documentation patch.
Date: Wed, 20 Nov 96 16:07:28 GMT
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: pod/perldiag.pod
private-msgid: <9611201607.AA12729@claudius.bfsec.bt.co.uk>
Subject: a missing perldiag entry
Date: Thu, 21 Nov 1996 15:24:02 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pod/perldiag.pod
private-msgid: <199611212024.PAA15758@aatma.engin.umich.edu>
Subject: perlfunc patch
Date: Wed, 20 Nov 96 14:04:08 GMT
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: pod/perlfunc.pod
Following on from the patch to make uc, lc etc default to $_ (as per
Camel II), here is a followup patch to perlfunc that documents the
change. I think I have documented all the other cases where $_
defaulting works as well.
p5p-msgid: <9611201404.AA12477@claudius.bfsec.bt.co.uk>
OTHER CORE CHANGES
Subject: Properly prototype safe{malloc,calloc,realloc,free}.
From: Chip Salzenberg <chip@atlantic.net>
Files: proto.h
Subject: UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1, allow debugging
Date: Wed, 20 Nov 1996 14:27:06 +0100
From: John Hughes <john@AtlanTech.COM>
Files: sv.c
UnixWare 2.1 has no fp->_base so most of the debugging stuff in sv_gets just
core dumps.
Also, for some unknown reason fp->_cnt is sometimes < -1, screwing up the
initial SvGROW in svgets.
Appart from that its io is std.
p5p-msgid: <01BBD6EE.E915C860@malvinas.AtlanTech.COM>
Subject: die -> croak
Date: Thu, 21 Nov 1996 16:11:21 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp_ctl.c
private-msgid: <199611212111.QAA17070@aatma.engin.umich.edu>
Subject: Cleanup of {,un}pack('w').
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c
Subject: Cleanups from Ilya.
From: Chip Salzenberg <chip@atlantic.net>
Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c
Subject: Fix for unpack('w') on 64-bit systems.
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c
Subject: Re: LC_NUMERIC support is ready + performance
Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: sv.c
Chip Salzenberg writes:
>
> Having thought about the use of our own gcvt() and atof(), I've run
> away in horror. It's just too hairy.
>
> So I've implemented the only viable alternative I know of: Toggling
> LC_NUMERIC to/from "C" as needed.
>
> Patch follows.
>
> I think _09 is *very* close.
Since _09 is going to be alpha anyway, I reiterate my question:
Is there any reason to not include my hash/array performance
patches in _09?
Btw, here is the next performance patch. It makes PADTMP values
stealable too. I do not do by setting TEMP flags on them, since it
would be a very distributed patch, and it would break some places
which check for TEMP for some other reasons (yes, I checked ;-).
This patch decreases *twice* the memory usage of
perl -e '$a = "a" x 1e6; 1'
Enjoy,
p5p-msgid: <199611260308.WAA02677@monk.mps.ohio-state.edu>
Subject: Hash key sharing improvements from Ilya.
From: Chip Salzenberg <chip@atlantic.net>
Files: hv.c hv.h proto.h
Subject: Mortal stack pre-allocation from Ilya.
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
PORTABILITY
Subject: VMS patches post-5.003_08
Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST)
From: Charles Bailey <bailey@hmivax.humgen.upenn.edu>
Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm lib/File/Path.pm mg.c pp_ctl.c utils/h2xs.PL vms/config.vms vms/descrip.mms vms/gen_shrfls.pl vms/genconfig.pl vms/perlvms.pod vms/vms.c vms/vmsish.h
Here're diffs to bring a base 5.003_08 up to the current VMS working
sources. Nearly all of the changes are VMS-specific, and comprise
miscellaneous bugfixes accumulated since 5.003_07, rather than any
particular problem with 5.003_08. I'm posting them here since some
of the patches change core files, and I'd like to insure that I
haven't accidentally created problems for anyone else.
With these and a couple of of the small patches already send to p5p,
5.003_08 builds clean and passes all tests under VMS.
Thanks, Chip, for all the work.
p5p-msgid: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu>
Diffstat (limited to 'hv.c')
-rw-r--r-- | hv.c | 190 |
1 files changed, 115 insertions, 75 deletions
@@ -55,6 +55,31 @@ more_he() return new_he(); } +static HEK * +save_hek(str, len, hash) +char *str; +I32 len; +U32 hash; +{ + char *k; + register HEK *hek; + + New(54, k, sizeof(U32) + sizeof(I32) + len + 1, char); + hek = (HEK*)k; + Copy(str, HK_KEY(hek), len, char); + (HK_KEY(hek))[len] = '\0'; + HK_LEN(hek) = len; + HK_HASH(hek) = hash; + return hek; +} + +void +unshare_hek(hek) +HEK *hek; +{ + unsharepvn(HK_KEY(hek),HK_LEN(hek),HK_HASH(hek)); +} + /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot * contains an SV* */ @@ -143,13 +168,16 @@ register U32 hash; return 0; if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) { + HEK *hek; + Newz(74, hek, 1, HEK); sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); entry = &He; HeVAL(entry) = sv; - HeKEY(entry) = (char*)keysv; - HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */ + HeKEY_hk(entry) = hek; + HeSVKEY_set(entry, keysv); + HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */ return entry; } @@ -248,13 +276,11 @@ register U32 hash; } entry = new_he(); - HeKLEN(entry) = klen; if (HvSHAREKEYS(hv)) - HeKEY(entry) = sharepvn(key, klen, hash); + HeKEY_hk(entry) = share_hek(key, klen, hash); else /* gotta do the real thing */ - HeKEY(entry) = savepvn(key,klen); + HeKEY_hk(entry) = save_hek(key, klen, hash); HeVAL(entry) = val; - HeHASH(entry) = hash; HeNEXT(entry) = *oentry; *oentry = entry; @@ -323,13 +349,11 @@ register U32 hash; } entry = new_he(); - HeKLEN(entry) = klen; if (HvSHAREKEYS(hv)) - HeKEY(entry) = sharepvn(key, klen, hash); + HeKEY_hk(entry) = share_hek(key, klen, hash); else /* gotta do the real thing */ - HeKEY(entry) = savepvn(key,klen); + HeKEY_hk(entry) = save_hek(key, klen, hash); HeVAL(entry) = val; - HeHASH(entry) = hash; HeNEXT(entry) = *oentry; *oentry = entry; @@ -726,12 +750,13 @@ I32 shared; if (!hent) return; SvREFCNT_dec(HeVAL(hent)); - if (HeKLEN(hent) == HEf_SVKEY) - SvREFCNT_dec((SV*)HeKEY(hent)); - else if (shared) - unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); + if (HeKLEN(hent) == HEf_SVKEY) { + SvREFCNT_dec(HeKEY_sv(hent)); + Safefree(HeKEY_hk(hent)); + } else if (shared) + unshare_hek(HeKEY_hk(hent)); else - Safefree(HeKEY(hent)); + Safefree(HeKEY_hk(hent)); del_he(hent); } @@ -743,12 +768,13 @@ I32 shared; if (!hent) return; sv_2mortal(HeVAL(hent)); /* free between statements */ - if (HeKLEN(hent) == HEf_SVKEY) - sv_2mortal((SV*)HeKEY(hent)); - else if (shared) - unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); + if (HeKLEN(hent) == HEf_SVKEY) { + sv_2mortal(HeKEY_sv(hent)); + Safefree(HeKEY_hk(hent)); + } else if (shared) + unshare_hek(HeKEY_hk(hent)); else - Safefree(HeKEY(hent)); + Safefree(HeKEY_hk(hent)); del_he(hent); } @@ -868,18 +894,22 @@ HV *hv; SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ } else { + HEK *hek; xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */ Zero(entry, 1, HE); + Newz(74, hek, 1, HEK); + HeKEY_hk(entry) = hek; HeKLEN(entry) = HEf_SVKEY; } magic_nextpack((SV*) hv,mg,key); if (SvOK(key)) { /* force key to stay around until next time */ - HeKEY(entry) = (char*)SvREFCNT_inc(key); - return entry; /* beware, hent_val is not set */ + HeSVKEY_set(entry, SvREFCNT_inc(key)); + return entry; /* beware, hent_val is not set */ } if (HeVAL(entry)) SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hk(entry)); del_he(entry); xhv->xhv_eiter = Null(HE*); return Null(HE*); @@ -913,7 +943,7 @@ register HE *entry; I32 *retlen; { if (HeKLEN(entry) == HEf_SVKEY) { - return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen); + return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen); } else { *retlen = HeKLEN(entry); @@ -927,7 +957,7 @@ hv_iterkeysv(entry) register HE *entry; { if (HeKLEN(entry) == HEf_SVKEY) - return sv_mortalcopy((SV*)HeKEY(entry)); + return sv_mortalcopy(HeKEY_sv(entry)); else return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""), HeKLEN(entry))); @@ -941,7 +971,9 @@ register HE *entry; if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { SV* sv = sv_newmortal(); - mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); + if (HeKLEN(entry) == HEf_SVKEY) + mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); + else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); return sv; } } @@ -970,31 +1002,39 @@ int how; sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); } -/* get a (constant) string ptr from the global string table - * string will get added if it is not already there. +char* +sharepvn(sv, len, hash) +char* sv; +I32 len; +U32 hash; +{ + return share_hek(sv, len, hash)->hk_key; +} + +/* possibly free a shared string if no one has access to it * len and hash must both be valid for str. */ -char * -sharepvn(str, len, hash) -char *str; +void +unsharepvn(str, len, hash) +char* str; I32 len; -register U32 hash; +U32 hash; { register XPVHV* xhv; register HE *entry; register HE **oentry; register I32 i = 1; I32 found = 0; - + /* what follows is the moral equivalent of: - - if (!(Svp = hv_fetch(strtab, str, len, FALSE))) - hv_store(strtab, str, len, Nullsv, hash); - */ + if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) { + if (--*Svp == Nullsv) + hv_delete(strtab, str, len, G_DISCARD, hash); + } */ xhv = (XPVHV*)SvANY(strtab); /* assert(xhv_array != 0) */ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; if (HeKLEN(entry) != len) @@ -1002,33 +1042,27 @@ register U32 hash; if (memcmp(HeKEY(entry),str,len)) /* is this it? */ continue; found = 1; - break; - } - if (!found) { - entry = new_he(); - HeKLEN(entry) = len; - HeKEY(entry) = savepvn(str,len); - HeVAL(entry) = Nullsv; - HeHASH(entry) = hash; - HeNEXT(entry) = *oentry; - *oentry = entry; - xhv->xhv_keys++; - if (i) { /* initial entry? */ - ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) - hsplit(strtab); + if (--HeVAL(entry) == Nullsv) { + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + Safefree(HeKEY_hk(entry)); + del_he(entry); + --xhv->xhv_keys; } + break; } - - ++HeVAL(entry); /* use value slot as REFCNT */ - return HeKEY(entry); + + if (!found) + warn("Attempt to free non-existent shared string"); } -/* possibly free a shared string if no one has access to it +/* get a (constant) string ptr from the global string table + * string will get added if it is not already there. * len and hash must both be valid for str. */ -void -unsharepvn(str, len, hash) +HEK * +share_hek(str, len, hash) char *str; I32 len; register U32 hash; @@ -1038,16 +1072,16 @@ register U32 hash; register HE **oentry; register I32 i = 1; I32 found = 0; - + /* what follows is the moral equivalent of: - if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) { - if (--*Svp == Nullsv) - hv_delete(strtab, str, len, G_DISCARD, hash); - } */ + + if (!(Svp = hv_fetch(strtab, str, len, FALSE))) + hv_store(strtab, str, len, Nullsv, hash); + */ xhv = (XPVHV*)SvANY(strtab); /* assert(xhv_array != 0) */ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; if (HeKLEN(entry) != len) @@ -1055,18 +1089,24 @@ register U32 hash; if (memcmp(HeKEY(entry),str,len)) /* is this it? */ continue; found = 1; - if (--HeVAL(entry) == Nullsv) { - *oentry = HeNEXT(entry); - if (i && !*oentry) - xhv->xhv_fill--; - Safefree(HeKEY(entry)); - del_he(entry); - --xhv->xhv_keys; - } break; } - - if (!found) - warn("Attempt to free non-existent shared string"); + if (!found) { + entry = new_he(); + HeKEY_hk(entry) = save_hek(str, len, hash); + HeVAL(entry) = Nullsv; + HeNEXT(entry) = *oentry; + *oentry = entry; + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(strtab); + } + } + + ++HeVAL(entry); /* use value slot as REFCNT */ + return HeKEY_hk(entry); } + |