X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/83029685b27ec04c6417a2eb865ffed0921d39ae..f38e12df2246599f9c1104d703d0b8bb03353e86:/mathoms.c

diff --git a/mathoms.c b/mathoms.c
index a8a28e6..9e1c546 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1,6 +1,6 @@
 /*    mathoms.c
  *
- *    Copyright (C) 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 2005, 2006, 2007, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -65,7 +65,9 @@ PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
-
+PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV AV * Perl_newAV(pTHX);
+PERL_CALLCONV HV * Perl_newHV(pTHX);
 
 /* ref() is now a macro using Perl_doref;
  * this version provided for binary compatibility only.
@@ -1210,6 +1212,132 @@ Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
 
     packlist(cat, pat, patend, beglist, endlist);
 }
+
+HE *
+Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
+{
+  return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
+}
+
+bool
+Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
+{
+    return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
+	? TRUE : FALSE;
+}
+
+HE *
+Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
+{
+    return (HE *)hv_common(hv, keysv, NULL, 0, 0, 
+		     (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
+}
+
+SV *
+Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
+{
+    return (SV *) hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
+			    hash);
+}
+
+SV**
+Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
+		    int flags)
+{
+    return (SV**) hv_common(hv, NULL, key, klen, flags,
+			    (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
+}
+
+SV**
+Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
+{
+    STRLEN klen;
+    int flags;
+
+    if (klen_i32 < 0) {
+	klen = -klen_i32;
+	flags = HVhek_UTF8;
+    } else {
+	klen = klen_i32;
+	flags = 0;
+    }
+    return (SV **) hv_common(hv, NULL, key, klen, flags,
+			     (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
+}
+
+bool
+Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
+{
+    STRLEN klen;
+    int flags;
+
+    if (klen_i32 < 0) {
+	klen = -klen_i32;
+	flags = HVhek_UTF8;
+    } else {
+	klen = klen_i32;
+	flags = 0;
+    }
+    return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
+	? TRUE : FALSE;
+}
+
+SV**
+Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
+{
+    STRLEN klen;
+    int flags;
+
+    if (klen_i32 < 0) {
+	klen = -klen_i32;
+	flags = HVhek_UTF8;
+    } else {
+	klen = klen_i32;
+	flags = 0;
+    }
+    return (SV **) hv_common(hv, NULL, key, klen, flags,
+			     lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
+			     : HV_FETCH_JUST_SV, NULL, 0);
+}
+
+SV *
+Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
+{
+    STRLEN klen;
+    int k_flags;
+
+    if (klen_i32 < 0) {
+	klen = -klen_i32;
+	k_flags = HVhek_UTF8;
+    } else {
+	klen = klen_i32;
+	k_flags = 0;
+    }
+    return (SV *) hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
+			    NULL, 0);
+}
+
+/* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
+
+AV *
+Perl_newAV(pTHX)
+{
+    return (AV*)newSV_type(SVt_PVAV);
+    /* sv_upgrade does AvREAL_only():
+    AvALLOC(av) = 0;
+    AvARRAY(av) = NULL;
+    AvMAX(av) = AvFILLp(av) = -1; */
+}
+
+HV *
+Perl_newHV(pTHX)
+{
+    HV * const hv = (HV*)newSV_type(SVt_PVHV);
+    assert(!SvOK(hv));
+
+    return hv;
+}
+
 #endif /* NO_MATHOMS */
 
 /*