/* 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.
#define PERL_IN_MATHOMS_C
#include "perl.h"
+PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
+PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
+PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
+PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
+PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
+PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
+PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
+PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
+PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv);
+PERL_CALLCONV void Perl_sv_force_normal(pTHX_ register SV *sv);
+PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr);
+PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
+PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len);
+PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr);
+PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv);
+PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
+PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
+PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
+PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
+PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv);
+PERL_CALLCONV NV Perl_huge(void);
+PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
+PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
+PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
+PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
+PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
+PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
+PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp);
+PERL_CALLCONV bool Perl_do_exec(pTHX_ const char *cmd);
+PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
+PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
+PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
+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.
*/
char *
Perl_sv_2pv_nolen(pTHX_ register SV *sv)
{
- return sv_2pv(sv, 0);
+ return sv_2pv(sv, NULL);
}
/*
char *
Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
{
- return sv_2pvbyte(sv, 0);
+ return sv_2pvbyte(sv, NULL);
}
/*
char *
Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
{
- return sv_2pvutf8(sv, 0);
+ return sv_2pvutf8(sv, NULL);
}
/*
if (SvPOK(sv))
return SvPVX(sv);
- return sv_2pv(sv, 0);
+ return sv_2pv(sv, NULL);
}
/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
char *
Perl_sv_pvbyte(pTHX_ SV *sv)
{
- sv_utf8_downgrade(sv,0);
+ sv_utf8_downgrade(sv, FALSE);
return sv_pv(sv);
}
char *
Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
{
- sv_utf8_downgrade(sv,0);
+ sv_utf8_downgrade(sv, FALSE);
return sv_pvn(sv,lp);
}
sv_magic((SV*)hv, (SV*)gv, how, NULL, 0);
}
-#if 0 /* use the macro from hv.h instead */
-
-char*
-Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
-{
- return HEK_KEY(share_hek(sv, len, hash));
-}
-
-#endif
-
AV *
Perl_av_fake(pTHX_ register I32 size, register SV **strp)
{
register SV** ary;
- register AV * const av = (AV*)newSV(0);
-
- sv_upgrade((SV *)av, SVt_PVAV);
+ register AV * const av = (AV*)newSV_type(SVt_PVAV);
Newx(ary,size+1,SV*);
AvALLOC(av) = ary;
Copy(strp,ary,size,SV*);
AvREIFY_only(av);
- SvPV_set(av, (char*)ary);
+ AvARRAY(av) = ary;
AvFILLp(av) = size - 1;
AvMAX(av) = size - 1;
while (size--) {
}
#endif
-#ifdef HAS_PIPE
-void
-Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
-{
- dVAR;
- register IO *rstio;
- register IO *wstio;
- int fd[2];
-
- if (!rgv)
- goto badexit;
- if (!wgv)
- goto badexit;
-
- rstio = GvIOn(rgv);
- wstio = GvIOn(wgv);
-
- if (IoIFP(rstio))
- do_close(rgv,FALSE);
- if (IoIFP(wstio))
- do_close(wgv,FALSE);
-
- if (PerlProc_pipe(fd) < 0)
- goto badexit;
- IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
- IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
- IoOFP(rstio) = IoIFP(rstio);
- IoIFP(wstio) = IoOFP(wstio);
- IoTYPE(rstio) = IoTYPE_RDONLY;
- IoTYPE(wstio) = IoTYPE_WRONLY;
- if (!IoIFP(rstio) || !IoOFP(wstio)) {
- if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else PerlLIO_close(fd[0]);
- if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else PerlLIO_close(fd[1]);
- goto badexit;
- }
-
- sv_setsv(sv,&PL_sv_yes);
- return;
-
-badexit:
- sv_setsv(sv,&PL_sv_undef);
- return;
-}
-#endif
-
/* Backwards compatibility. */
int
Perl_init_i18nl14n(pTHX_ int printwarn)
return init_i18nl10n(printwarn);
}
-/* XXX kept for BINCOMPAT only */
-void
-Perl_save_hints(pTHX)
-{
- Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
-}
-
-#if 0
-OP *
-Perl_ck_retarget(pTHX_ OP *o)
-{
- Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
- /* STUB */
- return o;
-}
-#endif
-
OP *
Perl_oopsCV(pTHX_ OP *o)
{
DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
}
-PP(pp_threadsv)
-{
- DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
-}
-
PP(pp_mapstart)
{
DIE(aTHX_ "panic: mapstart"); /* uses grepstart */
return pp_bit_or();
}
+PP(pp_rv2hv)
+{
+ return Perl_pp_rv2av(aTHX);
+}
+
U8 *
Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
{
}
void
-Perl_save_I16(pTHX_ I16 *intp)
-{
- dVAR;
- SSCHECK(3);
- SSPUSHINT(*intp);
- SSPUSHPTR(intp);
- SSPUSHINT(SAVEt_I16);
-}
-
-void
-Perl_save_I8(pTHX_ I8 *bytep)
-{
- dVAR;
- SSCHECK(3);
- SSPUSHINT(*bytep);
- SSPUSHPTR(bytep);
- SSPUSHINT(SAVEt_I8);
-}
-
-void
Perl_save_iv(pTHX_ IV *ivp)
{
dVAR;
}
}
-void
-Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
-{
- dVAR;
- SSCHECK(3);
- SSPUSHDPTR(f);
- SSPUSHPTR(p);
- SSPUSHINT(SAVEt_DESTRUCTOR);
-}
-
-
/*
=for apidoc sv_usepvn_mg
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 */
/*
https://perl5.git.perl.org / perl5.git / blobdiff